VBA - Apply Filter Across Multiple Sheets if Column Header is a Match and Delete Filtered Rows

[Eitel13]

Originally posted here:

https://stackoverflow.com/questions...s-multiple-sheets-if-column-header-is-a-match

I have a macro that renames certain headers, deletes certain columns and inserts a row on specific sheets.

I need to apply a filter across the sheets IF the header is found on the sheet.

Here is the complete code for the macro:

Sub ManipulateSheets()

    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
    Dim a As Long, w As Long
    Dim keepCols()
    Dim filterCols As Variant
    Dim wkbk1 As Workbook
    
    Set wkbk1 = Workbooks("testWorkbook.xlsm")
    
    'Set sheets to be used in each workbook
    Set ws2 = wkbk1.Sheets("thisSheet")
    Set ws3 = wkbk1.Sheets("thatSheet")
    Set ws4 = wkbk1.Sheets("mySheet")

    keepCols = Array("Employee Number", "Status")
    filterCols = Array("Status")
    
    wkbk1.Activate
    
    ws2.Range("A1").EntireRow.Insert
    ws2.Range("A1").Value = "Employee Number"
    
    ws3.Range("A1").EntireRow.Insert
    ws3.Range("A1").Value = "Employee Number"
    
    ws4.Range("A1").EntireRow.Insert
    ws4.Range("A1").Value = "Employee Number"
    
    For Each ws1 In wkbk1.Sheets
    
        ws1.Cells(1, 1).EntireRow.Replace What:="USERID", Replacement:="Employee Number", LookAt:=xlWhole
        ws1.Cells(1, 1).EntireRow.Replace What:="STATUS", Replacement:="Status", LookAt:=xlWhole
        ws1.Cells(1, 1).EntireRow.Replace What:="USER_ID", Replacement:="Employee Number", LookAt:=xlWhole
        ws1.Cells(1, 1).EntireRow.Replace What:="USER-ID", Replacement:="Employee Number", LookAt:=xlWhole
        ws1.Cells(1, 1).EntireRow.Replace What:="USER_STATUS", Replacement:="Status", LookAt:=xlWhole
        ws1.Cells(1, 1).EntireRow.Replace What:="HR_STATUS", Replacement:="Status", LookAt:=xlWhole
                
    Next ws1
    
    Call DeleteIrrelevantColumns
    
    With wkbk1
            
        For w = 1 To .Worksheets.count
        
            With Worksheets(w)
                        
                'Search for the Word "Status" on the first row of the Sheet
                Set StatusFound = Worksheets(w).Rows(1).Find(What:="Status", LookAt:=xlWhole)
                
                'If Status is found then apply filter
                If Not StatusFound Is Nothing Then

                    For a = .Columns.count To 1 Step -1
                        
                        If UBound(filter(filterCols, Worksheets(w).Cells(1, a), True, vbTextCompare)) < 0 Or IsEmpty(.Cells(1, a)) Then _

                            Worksheets(w).UsedRange.AutoFilter Field:=StatusFound.Column, Criteria1:=("INACTIVE"), Operator:=xlFilterValues
                            
                        End If
                    
                    Next a
                
                End If

                LstRw = .Cells(.Rows.count, "A").End(xlUp).Row
        
                Set rng = .Range("A2:A" & LstRw).SpecialCells(xlCellTypeVisible)
        
                'Delete visible cells
                rng.EntireRow.Delete
        
                'Remove filter
                .AutoFilterMode = False
            
            End With
        
        Next w
        
    End With
        
End Sub

Originally when I tested the "filter" code, it worked great - from what I can remember. But now, I have the same issue I was having on my other post, which is that the code gets stuck in an infinite loop and I can only exit it by "Ctrl + Break".

When I "break" it and click on debug, then it takes me to the End If of the If UBound statement.

I then proceed to check the sheets to see if the filter was applied, and it was only applied to the first sheet that had "Status" as a header. All the other sheets with "Status" it was not applied to.

I also have no clue if the second part works - to delete the filtered rows, which comes immediately after the filter. I do not know if it works because the code never reaches that line.

 

[Eitel13]

Hi Skip,

Thank you for the reply again..

I also stepped through the code you provided but it seems to be skipping the part where it applies the filter..

At this line:

If UBound(filter(filterCols, ws.Cells(1, a), True, vbTextCompare)) < 0 Or IsEmpty(.Cells(1, a)) Then _

It just skips to the end if..

"Here's your code. You failed to end your loop at 2 as I previously pointed out to you and the reason for ending it at column 2 as well."

At some point I did change it to 2 but considering it still deleted column A data I just left it at 1..

 

[SkipVought]

On which sheet?

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Eitel13]

On all the sheets.. I did a first pass just to check your code and see if it worked and then I noticed that not a single sheet had the filter applied to it.. So then I stepped through it to see what was happening.

 

[SkipVought]

I tested this yesterday. Don't know what changed.

But the If statement of offence is the compound expression
If UBound(filter(filterCols, ws.Cells(1, a), True, vbTextCompare)) < 0 Or IsEmpty(.Cells(1, a)) Then _

replace with

'
                For a = .UsedRange.Columns.count To 2 Step -1
                        
                    [b]If .Cells(1, a).Value = "Status" Then[/b]

                        ws.UsedRange.AutoFilter Field:=StatusFound.Column, Criteria1:=("INACTIVE"), Operator:=xlFilterValues
                            
                        bFound = True

                    End If
                    
                Next a

The AutoFiter ONLY occurs in the Status column, however you want to code it.

But this runs without deleting column A and filtering all Status columns.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Eitel13]

Good news Skip!

It's working 100%

Thank you for all your help! It really is greatly appreciated