E. Adams
E. Adams

Reputation: 1

Cycling through Filter and SaveCopyAs for multiple criteria using VBA

I have a spreadsheet with multiple tabs and data on each. For each cycle, I basically want to filter for the same criteria in each tab (different columns), save a copy (with today's date) and then move onto the next criteria and repeat the process, so I end up with a folder full of spreadsheets, one filtered for each criteria.

My ultimate goal is to cycle through multiple variables (If possible use a table to feed in the variables)

After much trial and error, I have managed to get it to filter and save a copy. The process only works for one criteria however. As soon as I chain them together, the naming and filtering process breaks down for some reason. I get multiple files but the naming/filtering does not match. e.g. Filtered for 'Dave', named 'Ben'

I guess I have 3 questions:

  1. Why is my code not working when the process cycles more than once?

  2. Is there an easier way to do this? Possibly with a table of Criteria, which is then cycled through, creating a filtered sheet for each one.

  3. I can't find a way to stop each saved file from opening when it cycles. Ideally I just want the files to be created without opening them.

Help would be really appreciated.

Sub AutoFilterMacro()
  Dim sct As String
  sct = "Ben"

Worksheets("January").Range("A1").AutoFilter _
 field:=7, _
 Criteria1:=sct & "*", _
 VisibleDropDown:=True

Worksheets("February").Range("A1").AutoFilter _
 field:=8, _
 Criteria1:=sct & "*", _
 VisibleDropDown:=True

Worksheets("March").Range("A1").AutoFilter _
 field:=9, _
 Criteria1:=sct & "*", _
 VisibleDropDown:=True

Worksheets("April").Range("A1").AutoFilter _
 field:=6, _
 Criteria1:=sct & "*", _
 VisibleDropDown:=True

Application.DisplayAlerts = False

 Dim Pre As String
 Pre = Format(Now, "dd-mm-yyyy")
 ThisWorkbook.Sheets.Copy
 With Workbooks(Workbooks.Count)
    .SaveAs ThisWorkbook.Path & "\" & sct & " " & Pre & ".xlsx", 51
 End With

 Application.DisplayAlerts = True

 Call AutoFilterMacro2

End Sub



Sub AutoFilterMacro2()
Dim sct As String
sct = "David"

Worksheets("January").Range("A1").AutoFilter _
 field:=7, _
 Criteria1:="*" & sct & "*", _
 VisibleDropDown:=True

Worksheets("February").Range("A1").AutoFilter _
 field:=8, _
 Criteria1:=sct & "*", _
 VisibleDropDown:=True

Worksheets("March").Range("A1").AutoFilter _
 field:=9, _
 Criteria1:=sct & "*", _
 VisibleDropDown:=True

Worksheets("April").Range("A1").AutoFilter _
 field:=6, _
 Criteria1:=sct & "*", _
 VisibleDropDown:=True

Application.DisplayAlerts = False

 Dim Pre As String
 Pre = Format(Now, "dd-mm-yyyy")
 ThisWorkbook.Sheets.Copy
 With Workbooks(Workbooks.Count)
     .SaveAs ThisWorkbook.Path & "\" & sct & " " & Pre & ".xlsx", 51
 End With

 Application.DisplayAlerts = True

 Call AutoFilterMacroX

End Sub

Upvotes: 0

Views: 365

Answers (1)

user3598756
user3598756

Reputation: 29421

assuming that the macro resides in the workbook with "January", "February", ... sheets, you can try this

Option Explicit

Sub AutoFilters()
Dim sheetsToFilter As Variant, sheetName As Variant
Dim sheetsColumnToFilterOn As Variant
Dim criteria As Variant, criterium As Variant
Dim iSht As Long
Dim pre As String

sheetsToFilter = Array("January", "February", "March", "April") '<== place here all the sheets name to be filtered
sheetsColumnToFilterOn = Array(7, 8, 9, 6) '<== place here each correspondant sheet column index on which to base the filter
criteria = Array("Ben", "David") '<== place here your different criteria

pre = Format(Now, "dd-mm-yyyy")

Application.ScreenUpdating = False

For Each criterium In criteria
    For iSht = LBound(sheetsToFilter) To UBound(sheetsToFilter)
        Call Autofilter(ThisWorkbook.Worksheets(sheetsToFilter(iSht)).Range("A1"), CLng(sheetsColumnToFilterOn(iSht)), CStr(criterium))
    Next iSht

    Call CopySheet(sheetsToFilter, ThisWorkbook.Path & "\" & criterium & " " & pre & ".xlsx")
Next criterium

Application.ScreenUpdating = True

End Sub


Sub Autofilter(rng As Range, col As Long, criteria As String)

With rng
    .Autofilter
    .Autofilter field:=col, Criteria1:=criteria & "*", VisibleDropDown:=True
End With

End Sub


Sub CopySheet(sheetsToFilter As Variant, shtName As String)

ThisWorkbook.Worksheets(sheetsToFilter).Copy
ActiveWorkbook.SaveAs Filename:=shtName
ActiveWorkbook.Close False

End Sub

Upvotes: 0

Related Questions