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.

 

[SkipVought]

I believe I mentioned this to you in an earlier post.

When deleting ranges in a loop the reference get destroyed and your code looses its way.

You MUST therefore loop in reverse as I demonstrated for you.

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

 

[Eitel13]

Hi Skip,

Ahhhh yes, I remember now!

Sorry Skip, long days and I cant think when I am done..

I got it working

Here is the code:

Sub ManipulateSheets()

    Dim ws As Worksheet
    Dim a As Long
    Dim filterCols As Variant
    Dim wkbk1 As Workbook
    
    Set wkbk1 = Workbooks("3rd Party.xlsm")
    filterCols = Array("Status")

    wkbk1.Activate

    For Each ws In wkbk1.Worksheets
        
        With ws
            'Search for the Word "Status" on the first row of the Sheet
            Set StatusFound = ws.Rows(1).Find(What:="Status", LookAt:=xlWhole)
                
            'If Status is found then apply filter
            If Not StatusFound Is Nothing Then

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

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

Thank you very much!

 

[SkipVought]

Be sure to put that one in your toolbox!

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

 

[Eitel13]

Just to get back to the original post regarding the deletion of the filtered cells..

The code for deleting works great, but it also deletes the visible cells on the sheets where the filter is not applied - because these sheets do not have a "Status" header..

Here is the code:

Sub ManipulateSheets()
    
    Dim wkbk1 As Workbook
    
    Set wkbk1 = Workbooks("3rd Party.xlsm")
    filterCols = Array("Status")

    wkbk1.Activate

    With wkbk1
            
        For w = 1 To .Worksheets.count
        
            With Worksheets(w)
                
                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

I thought that this line:

Set rng = .Range("A2:A" & LstRw).SpecialCells(xlCellTypeVisible)

Was supposed to ensure that it only delete cells that have been filtered, hence the SpecialCells(xlCellTypeVisible)?

 

[SkipVought]

Where is your filter???

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

 

[Eitel13]

Hi Skip,

So I realized you could be asking your question for two reasons:

1) Where is the actual code that applies the filter
2) In which column have I applied the filter

Answers:

1) The filter is already applied to all the sheets.

When I introduce a new piece of code to current macros, I usually put them into a separate macro first then once I get it working, I will integrate it to the existing macro.

2) I noticed in the code sample above, I applied the "delete" looking for the filtered cells in column A, when in actual fact the filter is applied to column B. In the below I have amended this.

So essentially, the entire macro would look like this:

Sub ManipulateSheets()
    
    Dim ws As Worksheet, ws1 As Worksheet
    Dim a As Long, w As Long, LstRw As Long
    Dim filterCols As Variant, WshtNames As Variant, WshtNameCrnt As Variant
    Dim wkbk1 As Workbook, wb As Workbook
    Dim rng As Range
    
    Set wkbk1 = Workbooks("testWorkbook.xlsm")
    filterCols = Array("Status")
            
    WshtNames = Array("ws1", "ws2", "ws3")
    
    wkbk1.Activate
    
    For Each WshtNameCrnt In WshtNames
        With Worksheets(WshtNameCrnt)
            .Range("A1").EntireRow.Insert
            .Range("A1").Value = "Employee Number"
        End With
    Next WshtNameCrnt
    
    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
    
    'Expected error: wb not found
    On Error Resume Next
    
    'Workbooks("testWorkbook")
    Set wb = ThisWorkbook

    If Not wb Is Nothing Then
        Application.ScreenUpdating = False
        For Each ws In wb.Worksheets
            ws.UsedRange.RemoveDuplicates Columns:=Array(1), Header:=xlYes
        Next
        Application.ScreenUpdating = True
    End If
       
    For Each ws In wkbk1.Worksheets
        
        With ws
        
            'Search for the Word "Status" on the first row of the Sheet
            Set StatusFound = ws.Rows(1).Find(What:="Status", LookAt:=xlWhole)
                
            'If Status is found then apply filter
            If Not StatusFound Is Nothing Then

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

                        ws.UsedRange.AutoFilter Field:=StatusFound.Column, Criteria1:=("INACTIVE"), Operator:=xlFilterValues
                            
                    End If
                    
                Next a
                
            End If
            
            LstRw = .Cells(.Rows.count, "B").End(xlUp).Row
        
                Set rng = .Range("B2:B" & LstRw).SpecialCells(xlCellTypeVisible)
        
                'Delete visible cells
                rng.EntireRow.Delete
        
                'Remove filter
                .AutoFilterMode = False
        
        End With
     
     Next
     
End Sub

Now what I am experiencing is that the code seems to be working great - it deletes the filtered cells rows across all the sheets - but on the sheets that only have one column (Employee Number), the actual header is deleted. Im not sure if anything else is deleted, just noticeably the header is deleted.

 

[SkipVought]

“but on the sheets that only have one column (Employee Number), the actual header is deleted.”

Change this...

Set rng = .Range("B2:B" & LstRw).SpecialCells(xlCellTypeVisible)

...to

Set rng = .Range("A2:A" & LstRw).SpecialCells(xlCellTypeVisible)

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

 

[Eitel13]

Hi Skip,

When I change the code as you suggested above, it deletes the data on the sheets where there is no filter applied.

I even thought of perhaps doing a check to see if a filter is applied to a sheet before it processes a deletion but it also deletes the data on the sheets where there is no filter applied.

Here is the link for where I found the code to check if there is a filter applied:

https://www.ozgrid.com/forum/forum/...vba-macro-if-worksheet-has-auto-filtered-rows

Code:

If Sheet1.AutoFilter.FilterMode = True Then


End If

or

On Error Resume Next
    If Not Sheet1.AutoFilter.Range.SpecialCells(xlCellTypeVisible) Is Nothing Then
On Error GoTo 0

    End If

Used within my code:

For Each ws In wkbk1.Worksheets
        
        With ws
        
            'Search for the Word "Status" on the first row of the Sheet
            Set StatusFound = ws.Rows(1).Find(What:="Status", LookAt:=xlWhole)
                
            'If Status is found then apply filter
            If Not StatusFound Is Nothing Then

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

                        ws.UsedRange.AutoFilter Field:=StatusFound.Column, Criteria1:=("INACTIVE"), Operator:=xlFilterValues
                            
                    End If
                    
                Next a
                
            End If
                        
            If .AutoFilter.FilterMode = True Then

                'On Error GoTo 0
                
                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 If
            
        End With
     
     Next

or

 For Each ws In wkbk1.Worksheets
        
        With ws
        
            'Search for the Word "Status" on the first row of the Sheet
            Set StatusFound = ws.Rows(1).Find(What:="Status", LookAt:=xlWhole)
                
            'If Status is found then apply filter
            If Not StatusFound Is Nothing Then

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

                        ws.UsedRange.AutoFilter Field:=StatusFound.Column, Criteria1:=("INACTIVE"), Operator:=xlFilterValues
                            
                    End If
                    
                Next a
                
            End If
            
            On Error Resume Next
            
            If Not .AutoFilter.Range.SpecialCells(xlCellTypeVisible) Is Nothing Then
            
                On Error GoTo 0
                
                'On Error GoTo 0
                
                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 If
            
        End With
     
     Next

 

[SkipVought]

You “Search for the Word ‘Status’ on the first row of the Sheet“

If you find it you apply a filter and display rows with INACTIVE.

Why not just set a flag as well?

‘
   [b]Dim bFound As Boolean[/b]     

            ‘If Status is found then apply filter
            If Not StatusFound Is Nothing Then

                [b]bFound = FALSE[/b]

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

                        ws.UsedRange.AutoFilter Field:=StatusFound.Column, Criteria1:=("INACTIVE"), Operator:=xlFilterValues
                            
                        [b]bFound =TRUE[/b]

                    End If
                    
                Next a
                
            End If

            [s]On Error Resume Next[/s]
            
            If [b]bFound[/b] Then
                
                LstRw = .Cells(.Rows.count, "A").End(xlUp).Row
        
                Set rng = .Range("A2:A" & LstRw).SpecialCells(xlCellTypeVisible)
        
                'Delete visible cells

                rng.EntireRow.Delete
            End If

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

 

[Eitel13]

Hi Skip,

Thank you for the reply.

I put your code into my macro and ran it but unfortunately it now deletes everything on all the sheets. So after I run the code and go into any sheet, the sheets are empty.

"Why not just set a flag as well?"

Could you explain what you mean by this please? I have not heard of this and not sure exactly what the purpose/function of this is?

 

[SkipVought]

Unfortunatly, we seem to be talking past each other.

Please upload your workbook or a representative version therof.

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

 

[Eitel13]

Ahhhh for the first time I have successfully managed to upload a file

I have attached the file that I use, I just changed the Employee Numbers and the names of the applications.

 

[SkipVought]

Where is your code?

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

 

[Eitel13]

Apologies Skip,

I thought you just wanted an xlsx file.. Attached is the xlsm file with the macros..

Module 4 is the one we are using here now..

 

[SkipVought]

Call ThirdParty4_DeleteIrrelevantColumns

Missing a procedure. I'm just ignoring this statement.

I also uncommented the lines of interest.

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

 

[SkipVought]

???

Right off [highlight #FCE94F]this[/highlight] happens because this table started in row 2

[pre]
[highlight #FCE94F]Employee Number[/highlight]
Employee Number
1
2
3
'...
[/pre]

???

Aren't we interested in the FILTER and DELETE code, which was commented out?

Did you comment out the wrong lines?

I'm not going to waste my time trying to figure out what code you want me to look at.

Please send me focused information. CLEAR, COMPLETE AND CONCISE.

I am willing and able to help, but NOT waste my time!

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

 

[Eitel13]

Hi Skip,

I'm sorry you seem to be getting irritated with me.

I am really not trying to waste your time because that wouldn't be beneficial to me either as it would then take longer to get a solution.

"I'm not going to waste my time trying to figure out what code you want me to look at.
Please send me focused information. CLEAR, COMPLETE AND CONCISE.
I am willing and able to help, but NOT waste my time!"

There is a TON of checking and editing I need to do before I can post it on the forum for help and unfortunately sometimes - although quite often lately - I miss one or two things or perhaps ask for help in the wrong way, but it's never with malicious intent.

I only uploaded my entire workbook so that you could see what I was doing to get to the point I was at.

I was hoping at least, by specifically mentioning which module to look at you wouldn't need to go through it all unnecessarily.

As for this:

"Call ThirdParty4_DeleteIrrelevantColumns
Missing a procedure. I'm just ignoring this statement.
I also uncommented the lines of interest."

I overlooked the call that was in this module and was supposed to comment it out.

"Aren't we interested in the FILTER and DELETE code, which was commented out?
Did you comment out the wrong lines?"

No, I did not comment out the wrong lines of code. I purposefully commented out this block of code to indicate where it is that the "work" is supposed to be done.

UPDATE:

I have uploaded a new version of the file with the following:

1. 19 Sheets - 1 Summary Sheet (empty) and 18 sheets named APP1 - APP18 (contain data)
2. Only 1 module with the relevant code
3. In the module I have put the code for the filter and deletion that you last provided me

I say again Skip, I am not trying to waste your time. I appreciate the time and effort you put into assisting me - not to mention the fact that you are extending your knowledge to me and those who read the threads in the future.

 

[SkipVought]

Thanks for your reply. I am out and about and won’t be back for several hours.

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

 

[SkipVought]

I STEPPED through your code watching what was happening. Had to temporarily make each sheet visible.

You need to learn how to do this for yourself.

Here's your code. You failed to [highlight #AD7FA8]end[/highlight] your loop at [highlight #AD7FA8]2[/highlight] as I previously pointed out to you and the reason for ending it at column 2 as well.

Also added Set StatusFound, which you failed to include.

So the things I provided and/or changed:

Moved the bFound = False up after For Each ws In wkbk1.Worksheets

Added a test for LstRw
If LstRw > 1 Then
below.

So this works for me to always keep Column A.

Sub Test3_ManipulateSheets()

    Dim ws As Worksheet, ws1 As Worksheet
    Dim a As Long, w As Long, LstRw As Long
    Dim filterCols As Variant, WshtNames As Variant, WshtNameCrnt As Variant
    Dim wkbk1 As Workbook, wb As Workbook
    Dim rng As Range
    Dim bFound As Boolean
    
    Set wkbk1 = ThisWorkbook
    
    wkbk1.Activate
       
    For Each ws In wkbk1.Worksheets

        With ws
            
            bFound = False

            'Search for the Word "Status" on the first row of the Sheet
            Set StatusFound = ws.Rows(1).Find(What:="Status", LookAt:=xlWhole)
            
            'If Status is found then apply filter
            If Not StatusFound Is Nothing Then


                For a = .UsedRange.Columns.count To [highlight #AD7FA8]2[/highlight] Step -1
                        
                    If UBound(Filter(filterCols, ws.Cells(1, a), True, vbTextCompare)) < 0 Or IsEmpty(.Cells(1, a)) Then _

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

                    End If
                    
                Next a
                
            End If

            On Error Resume Next
            
            If bFound Then
                
                LstRw = .Cells(.Rows.count, "A").End(xlUp).Row
                [b]If LstRw > 1 Then[/b]
                        Set rng = .Range("A2:A" & LstRw).SpecialCells(xlCellTypeVisible)
                
                        'Delete visible cells
                        rng.EntireRow.Delete
                        
                [b]End If
                'Remove filter
                .AutoFilterMode = False[/b]
            End If
        End With
     Next
    
End Sub

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