Reputation: 1
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:
Why is my code not working when the process cycles more than once?
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.
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
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