VBA, Advanced Filter Based on Header - vba

Question

I have an advanced filter macro to run in excel that filters certain columns for unique data. I have a bunch of workbooks as well, and have certain headers that are identical across these workbooks, but headers in each workbook may differ in columns.
So header 'Stackoverflow' may be Column F in one file, and Column E in another. I just want to alter my code to something generic so it gets filter this column with a particular header no matter which workbook (Instead of filtering e:e, f:f, etc). any input is appreciated.
EDIT: this is my full macro, the part where I filter is a bit further down.
Here is my code:
Sub stkoverflow()
Dim ws As Worksheet
Dim wks As Excel.Worksheet
Dim wksSummary As Excel.Worksheet
Dim y As Range
Dim intRow As Long, i As Integer
Dim r As Range, lr As Long, myrg As Range
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
lr = Cells(Rows.Count, "c").End(3).Row
Set myrg = Range("f2:f" & lr)
myrg.ClearContents
myrg.Formula = "=IFERROR(LEFT(e2,FIND(""_"",e2,1)-1),LEFT(e2,2))"
myrg.Value = myrg.Value
Range("f1").Value = "Test"
Next ws
On Error Resume Next
Set wksSummary = Excel.ActiveWorkbook.Worksheets("Unique data")
On Error GoTo 0
If wksSummary Is Nothing Then
Set wksSummary = Excel.ActiveWorkbook.Worksheets.Add
wksSummary.Name = "Unique data"
End If
For Each wks In Excel.ActiveWorkbook.Worksheets
With wksSummary
If wks.Name <> .Name Then
' THIS SECTION OF CODE IS POINTLESS. 'r' WILL ALWAYS BE DECLARED IRRESPECTIVE OF THE 'IF' STATEMENT
' If Application.WorksheetFunction.CountA(wks.Range("f:f")) Then
' Dim r As Range
' End If
With wksSummary
If wks.Name <> .Name Then
If Application.WorksheetFunction.CountA(wks.Range("a:a")) Then
Set r = .Cells(.Cells(.Rows.Count, 4).End(xlUp).Row + 1, 4)
Set y = .Cells(.Cells(.Rows.Count, 5).End(xlUp).Row + 0, 5)
If WorksheetFunction.CountA(wks.Range("f:f")) > 1 Then
If WorksheetFunction.CountA(wks.Range("a:a")) > 1 Then
wks.Range("f:f").AdvancedFilter xlFilterCopy, , r, True
wks.Range("a:a").AdvancedFilter xlFilterCopy, , y, True
Else
r = "N/A"
y = "N/A"
End If
End If
r.Delete xlShiftUp
End If
' I HAVE INSERTED BLOCK ENDINGS FROM HERE, AND CHANGED THE INDENTING OF THE SUBSEQUENT CODE TO FIT
' The next 4 lines are all inserted
End If
End With
End If
End With
' I have removed 4 x 'tab' indents from all of the code below
Next wks
Range("A1").Value = "File Name "
Range("B1").Value = "Sheet Name "
Range("D1").Value = "Scenario Name"
intRow = 2
For i = 1 To Sheets.Count
If Sheets(i).Name <> ActiveSheet.Name Then
Cells(intRow, 2) = Sheets(i).Name
Cells(intRow, 1) = ActiveWorkbook.Name
intRow = intRow + 1
End If
Next i
End Sub

Answer 1

Here is one way to get the column number of a header
Option Explicit
Public Function hdrCol(ByRef ws As Worksheet, _
ByVal hdrName As String, _
Optional hdrRow As Long = 1, _
Optional matchLtrCase As Boolean = True) As Long
Dim found As Range, foundCol As Long
If Not ws Is Nothing Then
hdrRow = Abs(hdrRow)
hdrName = Trim(hdrName)
If hdrRow > 0 And Len(hdrName) > 0 Then
Set found = ws.UsedRange.Rows.Find(What:=hdrName, _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
matchCase:=matchLtrCase)
If Not found Is Nothing Then foundCol = found.Column
End If
End If
hdrCol = foundCol
End Function
To test it:
Public Sub testHeader()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
MsgBox hdrCol(ws, "Stackoverflow")
Next
End Sub
.
Edit:
Changes I'd make to your code (not tested)
Option Explicit
Public Sub stkoverflow()
Dim wb As Workbook, ws As Worksheet, wsSummary As Worksheet, lr As Long
Dim y As Range, r As Range, thisRow As Long, colA As Range, colF As Range
Set wb = ActiveWorkbook
For Each ws In wb.Worksheets
lr = ws.Cells(ws.Rows.Count, "C").End(3).Row
With ws.Range("F2:F" & lr)
.ClearContents
.Formula = "=IFERROR(LEFT(E2,FIND(""_"",E2,1)-1),LEFT(E2,2))"
.Value = .Value
End With
ws.Range("F1").Value = "Test"
If ws.Name = "Unique data" Then Set wsSummary = ws
Next ws
If wsSummary Is Nothing Then
Set wsSummary = wb.Worksheets.Add
wsSummary.Name = "Unique data"
End If
For Each ws In wb.Worksheets
With wsSummary
If ws.Name <> .Name Then
'...
'Determine dynamic columns based on header
Set colA = ws.Columns(hdrCol(ws, "YOUR_HEADER_NAME_FOR_COL_A", 1, True))
Set colF = ws.Columns(hdrCol(ws, "YOUR_HEADER_NAME_FOR_COL_F", 1, True))
If ws.Name <> .Name Then
If Application.WorksheetFunction.CountA(colA) Then
Set r = .Cells(.Cells(.Rows.Count, 4).End(xlUp).Row + 1, 4)
Set y = .Cells(.Cells(.Rows.Count, 5).End(xlUp).Row + 0, 5)
If WorksheetFunction.CountA(colF) > 1 Then
If WorksheetFunction.CountA(colA) > 1 Then
colF.AdvancedFilter xlFilterCopy, , r, True
colA.AdvancedFilter xlFilterCopy, , y, True
Else
r = "N/A"
y = "N/A"
End If
End If
r.Delete xlShiftUp
End If
'...
End If
End If
End With
'...
Next ws
With ActiveSheet 'not sure about the ActiveSheet...
.Range("A1").Value = "File Name "
.Range("B1").Value = "Sheet Name "
.Range("D1").Value = "Scenario Name"
End With
thisRow = 2
For Each ws In wb.Worksheets
If ws.Name <> ActiveSheet.Name Then
ActiveSheet.Cells(thisRow, 2) = ws.Name
ActiveSheet.Cells(thisRow, 1) = wb.Name
thisRow = thisRow + 1
End If
Next
End Sub
'---------------------------------------------------------------------------------------