Macro that will loop through a filtered list and print each selection

I have a spreadshee that is always filtered in cell A9. I would like to create a macro to loop through each selection criteria and print. I have been able to create the initial macro but I need to be able to copy the macro to different worksheets/workbooks in the future and have it work. What is happening now is that I copy it and the pages that print are blank because it's looking for the selection criteria from the original sheet (the selection criteria will change from sheet to sheet but the filtered cell will always be A9). Any help would be greatly appreciated. Here is what I have:

Sub Printing()
'
' Printing Macro
'

'
    ActiveSheet.Range("$A$9:$J$62").AutoFilter Field:=1, Criteria1:= _
        "123456 ACT LLC"
    ActiveWindow.SelectedSheets.PrintOut Copies:=1
    ActiveSheet.Range("$A$9:$J$62").AutoFilter Field:=1, Criteria1:= _
        "234567 Alberto's Trucking"
    ActiveWindow.SelectedSheets.PrintOut Copies:=1
    ActiveSheet.Range("$A$9:$J$62").AutoFilter Field:=1, Criteria1:= _
        "345678 AV Trucking"
    ActiveWindow.SelectedSheets.PrintOut Copies:=1
    ActiveSheet.Range("$A$9:$J$62").AutoFilter Field:=1
End Sub

Hi, bobbysue25,

welcome to ExcelForum. Please be reminded that you would need to wrap your procedure with code-tags when being shown here according to Forum Rule #3

You could either use WorksheetFunction.CountIf for the data range to make sure that an itrem exists or get the row number for the last visible row which should be greater than the title row in order to print:

Sub Printing()
'
' Printing Macro
'

Dim lngLR As Long
'
With ActiveSheet
  .Range("$A$9:$J$62").AutoFilter Field:=1, Criteria1:="123456 ACT LLC"
  lngLR = .Range("A" & Rows.Count).End(xlUp).Row
  If lngLR > 9 Then .PrintOut Copies:=1
  .Range("$A$9:$J$62").AutoFilter Field:=1, Criteria1:="234567 Alberto's Trucking"
  lngLR = .Range("A" & Rows.Count).End(xlUp).Row
  If lngLR > 9 Then .PrintOut Copies:=1
  .Range("$A$9:$J$62").AutoFilter Field:=1, Criteria1:="345678 AV Trucking"
  lngLR = .Range("A" & Rows.Count).End(xlUp).Row
  If lngLR > 9 Then .PrintOut Copies:=1
  .Range("$A$9:$J$62").AutoFilter Field:=1
End With
End Sub

Ciao,
Holger

Hi, bobbysue25,

Your opening post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here



(This thread should receive no further responses until this moderation request is fulfilled, as per Forum Rule 7)

Ciao,
Holger

Hi, bobbysue25,

both codes go into a standard module:

Function myList(sh As String, lngCol As Long)
  Dim vntList(), n As Long, vntC, vntTmp
  Dim myCol As New Collection
  With Sheets(sh)
    ReDim vntList(1 To .Cells(Rows.Count, lngCol).End(xlUp).Row)
    vntTmp = .Range(.Cells(10, lngCol), .Cells(Rows.Count, lngCol).End(xlUp))
  End With
  For Each vntC In vntTmp
    Err.Clear
    On Error Resume Next
    myCol.Add vntC, CStr(vntC)
    If Err.Number = 0 Then
      n = n + 1
      vntList(n) = vntC
    End If
  Next
  ReDim Preserve vntList(1 To n)
  myList = vntList
End Function
Sub Printing()
'
' Printing Macro
'

Dim lngLR As Long
Dim varList As Variant
'
varList = myList(ActiveSheet.Name, 1)

With ActiveSheet
  For lngLR = LBound(varList) To UBound(varList)
    .Range("A9").CurrentRegion.AutoFilter Field:=1, Criteria1:=varList(lngLR)
    .PrintOut Copies:=1
  Next lngLR
End With
End Sub

The Function will create a list of all unique items in Column A and then loop through the Collection in order to print. There must be no check as only those items being listed are printed.

Ciao,
Holger