Hello experts!
I am trying to create a macro that:
1) Takes all sheet names and place on a sheet(A)
2) loop through the sheet names on sheet(A) to find sheet(s) matching a specific naming convention
3) If a sheet(dynamic) is found with the correct naming convention, then perform a second loop to
A) Take cell value in Cells(6, x) and search a different sheet(B) (same workbook) along row 1 to identify a column header
B) Once the column header is found, filter that column based on list of dynamic list of of criteria located under sheet(dynamic).Cells(6, x)
C) Move to next column on Sheet(dynamic) and continue to filter like above until all necessary columns are filtered
4) Perform another Sub()
5) Clear all filters from Sheet(B) and then go to next sheet name on sheet(A) and repeat entire loop
Hopefully this makes sense. Please see my code below. I seem to be incorrectly defining the array and then when I attempt to filter the columns, it loops through all of the options, but only one filter is applied (not all).
Thanks in advance!!!
I am trying to create a macro that:
1) Takes all sheet names and place on a sheet(A)
2) loop through the sheet names on sheet(A) to find sheet(s) matching a specific naming convention
3) If a sheet(dynamic) is found with the correct naming convention, then perform a second loop to
A) Take cell value in Cells(6, x) and search a different sheet(B) (same workbook) along row 1 to identify a column header
B) Once the column header is found, filter that column based on list of dynamic list of of criteria located under sheet(dynamic).Cells(6, x)
C) Move to next column on Sheet(dynamic) and continue to filter like above until all necessary columns are filtered
4) Perform another Sub()
5) Clear all filters from Sheet(B) and then go to next sheet name on sheet(A) and repeat entire loop
Hopefully this makes sense. Please see my code below. I seem to be incorrectly defining the array and then when I attempt to filter the columns, it loops through all of the options, but only one filter is applied (not all).
VBA Code:
Sub Filter()
'
' Filter Export Macro
'Dim StartTime As Double
'Dim MinutesElapsed As String
'StartTime = Timer
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Dim WB As Workbook: Set WB = ActiveWorkbook
Dim last_row As Long, last_col As Long, last_row2 As Long, last_col2 As Long
Dim includedCol As Long, includedCol2 As Long
Dim rngFound As Range
Dim Col As Long, Col2 As Long
Dim LROW As Long
Dim usedRange As Range
Dim cell As Range
Dim shEB As Worksheet
Dim colString As String, colString2 As String
Dim FoundSheet As Worksheet
Dim i As Long
Dim myArray() As Variant
'Delete existing ConfigFilter_Sheets tab if present
Dim Sheet As Worksheet
For Each Sheet In WB.Worksheets
If Sheet.Name = "ConfigFilter_Sheets" Then
Application.DisplayAlerts = False
Sheet.Delete
Application.DisplayAlerts = True
End If
Next Sheet
'Add new ConfigFilter_Sheets tab and make list of sheet names
Dim Filter_Sheets As Worksheet
Dim z As Long
WB.Sheets.Add(After:=WB.Sheets("Config_Review_Wiring")).Name = "ConfigFilter_Sheets"
Set Filter_Sheets = WB.Worksheets("ConfigFilter_Sheets")
For z = 1 To ThisWorkbook.Sheets.Count
Filter_Sheets.Cells(z, 1) = z
Filter_Sheets.Cells(z, 2) = ThisWorkbook.Sheets(z).Name
Next z
With Filter_Sheets
.Rows(1).Insert
.Cells(1, 1) = "Index"
.Cells(1, 1).Font.Bold = True
.Cells(1, 2) = "Filter_Sheets"
.Cells(1, 2).Font.Bold = True
.Columns("A:B").AutoFit
End With
Set shEB = WB.Worksheets("EaselBoard_1")
last_row = shEB.Cells(Rows.Count, 1).End(xlUp).Row
last_col = shEB.Cells(1, Columns.Count).End(xlToLeft).Column
includedCol = 2
Col = 2
colString = ""
'Loop through Config_Filter sheets to filter
Do While WB.Sheets("ConfigFilter_Sheets").Cells(includedCol, 2) <> ""
If WB.Sheets("ConfigFilter_Sheets").Cells(includedCol, 2).Value Like "Config_Filter*" Then
colString = WB.Sheets("ConfigFilter_Sheets").Cells(includedCol, 2)
Set FoundSheet = WB.Sheets(colString)
'shEB.ShowAllData
last_col2 = FoundSheet.Cells(6, Columns.Count).End(xlToLeft).Column
includedCol2 = 1
Col2 = 1
colString2 = ""
Do While FoundSheet.Cells(6, includedCol2) <> ""
If FoundSheet.Cells(6, includedCol2) = "" Then
Set rngFound = WB.Sheets("EaselBoard_1").Range("1:1").Find(What:=FoundSheet.Cells(6, includedCol2), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
Else
colString2 = FoundSheet.Cells(6, includedCol2)
Set rngFound = shEB.Range("1:1").Find(What:=colString2, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
End If
If Not rngFound Is Nothing Then
FoundSheet.Select
FoundSheet.Cells(6, includedCol2).Select
LROW = FoundSheet.Cells(Rows.Count, includedCol2).End(xlUp).Row
Set usedRange = FoundSheet.Range(Cells(7, includedCol2), Cells(LROW, includedCol2))
i = 1
For Each cell In usedRange.Cells
ReDim myArray(i)
myArray(i) = cell.Value
i = i + 1
Next cell
For i = LBound(myArray) To UBound(myArray)
rngFound.AutoFilter rngFound.Column, Array(myArray(i)), xlFilterValues
Next i
Else
If colString2 = "" Then
MsgBox "Cannot find column: " & FoundSheet.Cells(6, includedCol2)
End
Else
MsgBox "Cannot find column matching: " & colString2
End If
End If
includedCol2 = includedCol2 + 1
Loop
End If
Col = Col + 1
includedCol = includedCol + 1
LoopThanks in advance!!!
