VBA to loop among filter criteria in a specific column

[Mgiug]

Dears,
I'm a super noob with excel vba macro, I was able to write some codes time to time by adapting already existing ones from the net or via macro recording.

This time I was not able to find a solution wandering through the net, I'll try to explain what I would like to achieve.

I have an excel sheet, clearly bigger, but more or less like the following (it is not a table neither a pivot table, it is just a worsheet filled with data):
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]date[/TD]
[TD]driver[/TD]
[TD]customer[/TD]
[TD]address[/TD]
[TD]qty[/TD]
[/TR]
[TR]
[TD]august 21st[/TD]
[TD]JOHN[/TD]
[TD]15632[/TD]
[TD]street red 23[/TD]
[TD]150[/TD]
[/TR]
[TR]
[TD]august 21st[/TD]
[TD]JOHN[/TD]
[TD]85963[/TD]
[TD]square blue 1[/TD]
[TD]560[/TD]
[/TR]
[TR]
[TD]august 21st[/TD]
[TD]JOHN[/TD]
[TD]68932[/TD]
[TD]street green 16[/TD]
[TD]50[/TD]
[/TR]
[TR]
[TD]august 21st[/TD]
[TD]THOMAS[/TD]
[TD]11250[/TD]
[TD]street purple 15[/TD]
[TD]32[/TD]
[/TR]
[TR]
[TD]august 21st[/TD]
[TD]THOMAS[/TD]
[TD]86532[/TD]
[TD]square yellow 890[/TD]
[TD]652[/TD]
[/TR]
[TR]
[TD]august 22nd[/TD]
[TD]ROBERT[/TD]
[TD]74569[/TD]
[TD]street black 12[/TD]
[TD]263[/TD]
[/TR]
[TR]
[TD]august 22nd[/TD]
[TD]ROBERT[/TD]
[TD]30002[/TD]
[TD]square grey 15[/TD]
[TD]170[/TD]
[/TR]
</tbody>[/TABLE]


On the column headers I have an autofilter, I would like to automatically filter each driver name one by one and perform a print action. It means I want to filter JOHN and print, then filter THOMAS and print and so forth, everything automatically just by pressing a button.

I was not able to figure out how to automatically filter for all the available criteria in driver's column (the other columns filter will be manually applied by the final user).

The total number of driver is around 80 (by the way they can partially change every month), everyday I will have around 30 drivers but they can be different from the previous day.

Hope I explained myself decently.

Thank you so much

Maurizio

 

[Mgiug]

Hi guys,
Any tips?

Thanks!

 

[John_w]

Try this:

Public Sub Print_Drivers()

    Dim DriversDict As Object, Drivers As Variant, i As Long, Driver As Variant
    
    Set DriversDict = CreateObject("Scripting.Dictionary")
    
    'The code looks at data on the active sheet
    
    With ActiveSheet

        'Show AutoFilter if not already and all rows
        
        If Not .AutoFilterMode Then .UsedRange.AutoFilter
        If .Cells.AutoFilter Then .Cells.AutoFilter
    
        'Create list of unique Drivers in column B
        
        Drivers = Range(.Range("B2"), .Cells(Rows.Count, "B").End(xlUp))
        For i = 1 To UBound(Drivers, 1)
            DriversDict(Drivers(i, 1)) = 1
        Next
        
        'For each unique Driver
        
        For Each Driver In DriversDict.keys
            
            'AutoFilter on column B with this Driver
            
            .UsedRange.AutoFilter Field:=2, Criteria1:=Driver
            
            'Print filtered data
            
            .PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
        Next
    
        'Clear all filters
        
        If .Cells.AutoFilter Then .Cells.AutoFilter
        
    End With
    
End Sub

 

[Mgiug]

Thank a lot! Great!

Just didn't really get how "Show AutoFilter if not already and all rows" should work, but in my case the header range to autofilter is fixed so I found another way.

Following is the final code:

Public Sub PrintAllDrivers()
    
    Dim DriversDict As Object
    Dim Drivers As Variant
    Dim i As Long
    Dim Driver As Variant
    Dim CriteriaDay As Date
    Dim CriteriaTrip As Integer
    
    Set DriversDict = CreateObject("Scripting.Dictionary")
    
'The code looks at data on the active sheet
    
    With ActiveSheet

'Set AutoFilter
        
        .AutoFilterMode = False
        .Range("B5:W5").AutoFilter
        
'Set Day and Trip to be filtered by Input Box data
    
EnterHere:
    On Error GoTo ErrHandler
    CriteriaDay = InputBox("Insert delivery date" & vbCrLf & vbCrLf & "Formato: GG/MM/AA", "Delivery Date")
    Range("H4").Value = CriteriaDay

EnterHere2:
    On Error GoTo ErrHandler2
    CriteriaTrip = InputBox("Insert trip number", "Trip Number")
        .Range("B5:W5").AutoFilter Field:=1, Criteria1:=Range("H4").Text
        .Range("B5:W5").AutoFilter Field:=3, Criteria1:=CriteriaTrip
        
    End With
        
    Answer = MsgBox("Delivery date:  " & CriteriaDay & vbCrLf & "Trip:  " & CriteriaTrip & vbCrLf & vbCrLf & "Proceed with print out?", vbOKCancel, "All Trips Printing")
    If Answer = vbCancel Then
    Exit Sub

    Else

    With ActiveSheet
                  
'Create list of unique Drivers in column C
        
        Drivers = Range(.Range("C6"), .Cells(Rows.Count, "C").End(xlUp))
        For i = 1 To UBound(Drivers, 1)
            DriversDict(Drivers(i, 1)) = 1
        Next
        
'For each unique Driver
        
        For Each Driver In DriversDict.keys
            
'AutoFilter on column C with this Driver
            
        .UsedRange.AutoFilter Field:=2, Criteria1:=Driver
        
         Rows("1:3").Select
        Selection.RowHeight = 45
  
        Application.ScreenUpdating = False
        ActiveSheet.Select
        Range(Cells(1, 2), Cells(Range("B2005").End(xlUp).Row, 21)).PrintOut Copies:=1, Collate:=True

        Next
    
        Rows("1:3").Select
        Selection.RowHeight = 2
    
        .Range("B5:W5").AutoFilter Field:=2
        
    End With
    
End If
    
MsgBox ("Printing procedure ended")

Exit Sub
 
'To handle debug errors in case of invalid format for Day and Trip InputBox
 
ErrHandler:
Answer = MsgBox("Delivery Date is invalid, click 'OK' to insert it again", vbOKCancel, "Wrong Delivery Date")
If Answer = vbCancel Then
Exit Sub
Else
Resume EnterHere
End If
 
ErrHandler2:
Answer = MsgBox("Trip Number is invalid, click 'OK' to insert it again", vbOKCancel, "Wrong Trip")
If Answer = vbCancel Then
Exit Sub
Else
Resume EnterHere2
End If

End Sub

 

[Mgiug]

Hi John_w,
Badly to say my code doesn't really work, I tested it on an empty sheet with new data and everything looked fine, but when I moved the VBA macro on the real sheet it was a mess.

The fact is that I have data in the sheet that covers many months.
By putting the filter on date first and then running your code I assumed wrongly I would have get the Scripting Dictionary (aka my drivers list) only for the shown date (let's say as an example only the drivers on 22nd August), so the macro would have filtered only among these drivers and only print these ones.

Instead the macro is filtering drivers that were not available on the 22nd August, surely it is due to the fact that they were available before that day and the macro works also on the hidden rows.
In the end what I get is a big number of blank pages, with only the headers, cause the macro applies filter on driver column also on the hidden drivers.

Hope I have been clear enough.
Any tips how to solve it?

Thankssss