Delete all hidden rows after filtering

[VBAProIWish]

Hello All,

I currently have this code here that deletes any rows that have "Grape" in the "Fruit" column...

Sub Delete_rows_with_text_x_in_col_x()
Dim cell_to_check As Variant
Dim range_to_check As Range
Dim nCol As Long
Dim rCount As Long
With ActiveSheet
    nCol = Application.Match("Fruit", .Rows(1), 0)
    For rCount = .UsedRange.Rows.Count To 2 Step -1
        Select Case .Cells(rCount, nCol).Value
                Case "grape", "GRAPE"
                .Rows(rCount).EntireRow.Delete
        End Select
    Next
End With

But the code seems pretty slow. Is there a way, using the autofilter that this code can be faster?


I was thinking, logically, it could be this way here...

1. Autofilter the entire workbook
2. Filter the fruit column for all values except "grape" or "GRAPE".
3. Delete any rows not visible, which would be any rows that contain "grape" or "GRAPE".

Can this be done via code?

Thanks much

 

[Colin Legg]

Please can you post all of the code from the entire code module? I need a better idea of the big picture...

Thanks

 

[VBAProIWish]

Colin,

Here you go...

    Dim rngFound As Range, rngToDelete As Range, rngFruit As Range
    Dim strFirstAddress As String
    Dim varList As Variant
    Dim lngCounter As Long
 
Sub Mod_15()
 
 
Sheets("Totals").Select
 
 'Sub Del_Rows_with_Text_in_ColX_BEST()
 
    Const strFRUITHEADER As String = "Description"
 
 '   Dim rngFound As Range, rngToDelete As Range, rngFruit As Range
 '   Dim strFirstAddress As String
 '   Dim varList As Variant
 '   Dim lngCounter As Long
 
    Application.ScreenUpdating = False
 
    Set rngFruit = ActiveSheet.Rows(1).Find( _
                            what:=strFRUITHEADER, _
                            Lookat:=xlWhole, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False _
                                    )
 
    If Not rngFruit Is Nothing Then
 
        varList = VBA.Array("", "Produce totals", "Product totals")
 
        For lngCounter = LBound(varList) To UBound(varList)
 
            With rngFruit.EntireColumn
                Set rngFound = .Find( _
                                    what:=varList(lngCounter), _
                                    Lookat:=xlWhole, _
                                    SearchOrder:=xlByRows, _
                                    SearchDirection:=xlNext, _
                                    MatchCase:=False _
                                        )
 
 
                If Not rngFound Is Nothing Then
                    If rngToDelete Is Nothing Then
                        Set rngToDelete = rngFound
                    Else
                        Set rngToDelete = Application.Union(rngToDelete, rngFound)
                    End If
 
                    strFirstAddress = rngFound.Address
                    Set rngFound = .FindNext(After:=rngFound)
 
                    Do Until rngFound.Address = strFirstAddress
                        Set rngToDelete = Application.Union(rngToDelete, rngFound)
                        Set rngFound = .FindNext(After:=rngFound)
                    Loop
                End If
            End With
        Next lngCounter
 
        If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
    End If
 
    Application.ScreenUpdating = True
'End Sub
 
 
 
 
Sheets("Picked").Select
 
 
 'Sub Del_Rows_with_Text_in_ColX_BEST()
 
    Const strFRUITHEADER As String = "Description"
 
 '   Dim rngFound As Range, rngToDelete As Range, rngFruit As Range
 '   Dim strFirstAddress As String
 '   Dim varList As Variant
 '   Dim lngCounter As Long
 
    Application.ScreenUpdating = False
 
    Set rngFruit = ActiveSheet.Rows(1).Find( _
                            what:=strFRUITHEADER, _
                            Lookat:=xlWhole, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False _
                                    )
 
    If Not rngFruit Is Nothing Then
 
        varList = VBA.Array("", "Opened Totals")
 
        For lngCounter = LBound(varList) To UBound(varList)
 
            With rngFruit.EntireColumn
                Set rngFound = .Find( _
                                    what:=varList(lngCounter), _
                                    Lookat:=xlWhole, _
                                    SearchOrder:=xlByRows, _
                                    SearchDirection:=xlNext, _
                                    MatchCase:=False _
                                        )
 
 
                If Not rngFound Is Nothing Then
                    If rngToDelete Is Nothing Then
                        Set rngToDelete = rngFound
                    Else
                        Set rngToDelete = Application.Union(rngToDelete, rngFound)
                    End If
 
                    strFirstAddress = rngFound.Address
                    Set rngFound = .FindNext(After:=rngFound)
 
                    Do Until rngFound.Address = strFirstAddress
                        Set rngToDelete = Application.Union(rngToDelete, rngFound)
                        Set rngFound = .FindNext(After:=rngFound)
                    Loop
                End If
            End With
        Next lngCounter
 
        If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
    End If
 
    Application.ScreenUpdating = True
'End Sub
 
 
 
 
Sheets("Shipped").Select
 
 'Sub Del_Rows_with_Text_in_ColX_BEST()
 
    Const strFRUITHEADER As String = "Description"
 
 '   Dim rngFound As Range, rngToDelete As Range, rngFruit As Range
 '   Dim strFirstAddress As String
 '   Dim varList As Variant
 '   Dim lngCounter As Long
 
    Application.ScreenUpdating = False
 
    Set rngFruit = ActiveSheet.Rows(1).Find( _
                            what:=strFRUITHEADER, _
                            Lookat:=xlWhole, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False _
                                    )
 
    If Not rngFruit Is Nothing Then
 
        varList = VBA.Array("", "Region totals", "Produce totals")
 
        For lngCounter = LBound(varList) To UBound(varList)
 
            With rngFruit.EntireColumn
                Set rngFound = .Find( _
                                    what:=varList(lngCounter), _
                                    Lookat:=xlWhole, _
                                    SearchOrder:=xlByRows, _
                                    SearchDirection:=xlNext, _
                                    MatchCase:=False _
                                        )
 
 
                If Not rngFound Is Nothing Then
                    If rngToDelete Is Nothing Then
                        Set rngToDelete = rngFound
                    Else
                        Set rngToDelete = Application.Union(rngToDelete, rngFound)
                    End If
 
                    strFirstAddress = rngFound.Address
                    Set rngFound = .FindNext(After:=rngFound)
 
                    Do Until rngFound.Address = strFirstAddress
                        Set rngToDelete = Application.Union(rngToDelete, rngFound)
                        Set rngFound = .FindNext(After:=rngFound)
                    Loop
                End If
            End With
        Next lngCounter
 
        If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
    End If
 
    Application.ScreenUpdating = True
'End Sub
 
 
 
 
Sheets("Received").Select
 
 
 'Sub Del_Rows_with_Text_in_ColX_BEST()
 
    Const strFRUITHEADER As String = "Description"
 
 '   Dim rngFound As Range, rngToDelete As Range, rngFruit As Range
 '   Dim strFirstAddress As String
 '   Dim varList As Variant
 '   Dim lngCounter As Long
 
    Application.ScreenUpdating = False
 
    Set rngFruit = ActiveSheet.Rows(1).Find( _
                            what:=strFRUITHEADER, _
                            Lookat:=xlWhole, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False _
                                    )
 
    If Not rngFruit Is Nothing Then
 
        varList = VBA.Array("", "Region Totals", "Produce totals")
 
        For lngCounter = LBound(varList) To UBound(varList)
 
            With rngFruit.EntireColumn
                Set rngFound = .Find( _
                                    what:=varList(lngCounter), _
                                    Lookat:=xlWhole, _
                                    SearchOrder:=xlByRows, _
                                    SearchDirection:=xlNext, _
                                    MatchCase:=False _
                                        )
 
 
                If Not rngFound Is Nothing Then
                    If rngToDelete Is Nothing Then
                        Set rngToDelete = rngFound
                    Else
                        Set rngToDelete = Application.Union(rngToDelete, rngFound)
                    End If
 
                    strFirstAddress = rngFound.Address
                    Set rngFound = .FindNext(After:=rngFound)
 
                    Do Until rngFound.Address = strFirstAddress
                        Set rngToDelete = Application.Union(rngToDelete, rngFound)
                        Set rngFound = .FindNext(After:=rngFound)
                    Loop
                End If
            End With
        Next lngCounter
 
        If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
    End If
 
    Application.ScreenUpdating = True
 
 
 
End Sub

I hope that helps..

Thanks

 

[Colin Legg]

I think that this should do it, but obviously I haven't tested it beyond checking that it compiles. Just check that I've matched up the worksheet names and the keywords correctly before running it on a backup of your workbook.

Sub Mod_15()
    Const strCOLHEADER As String = "Description"
 
    Dim rngToCheck As Range
    Dim wstToCheck As Worksheet
    Dim varKeyWords As Variant
 
    Application.ScreenUpdating = False
 
    For Each wstToCheck In Worksheets(VBA.Array("Totals", "Picked", "Shipped", "Received"))
 
        Set rngToCheck = wstToCheck.Rows(1).Find( _
                                what:=strCOLHEADER, _
                                Lookat:=xlWhole, _
                                SearchOrder:=xlByColumns, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
 
        If Not rngToCheck Is Nothing Then
 
            Select Case VBA.UCase$(wstToCheck.Name)
                Case "TOTALS"
                    varKeyWords = VBA.Array("", "Produce totals", "Product totals")
                Case "PICKED"
                    varKeyWords = VBA.Array("", "Opened Totals")
                Case "SHIPPED", "RECEIVED"
                    varKeyWords = VBA.Array("", "Region totals", "Produce totals")
            End Select
 
            DeleteRows rngToCheck.EntireColumn, varKeyWords
        End If
    Next wstToCheck
 
    Application.ScreenUpdating = True
 
End Sub
 
Sub DeleteRows(ByVal rngToCheck As Range, _
                ByRef varKeyWords As Variant, _
                Optional ByVal blnCaseSensitive As Boolean = False)
 
    Dim rngFound As Range, rngToDelete As Range
    Dim strFirstAddress As String
    Dim lngCounter As Long
 
    For lngCounter = LBound(varKeyWords) To UBound(varKeyWords)
 
        Set rngFound = rngToCheck.Find( _
                                what:=varKeyWords(lngCounter), _
                                Lookat:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=blnCaseSensitive _
                                        )
 
        If Not rngFound Is Nothing Then
            If rngToDelete Is Nothing Then
                Set rngToDelete = rngFound
            Else
                    Set rngToDelete = Application.Union(rngToDelete, rngFound)
            End If
 
            strFirstAddress = rngFound.Address
            Set rngFound = rngToCheck.FindNext(After:=rngFound)
 
            Do Until rngFound.Address = strFirstAddress
                Set rngToDelete = Application.Union(rngToDelete, rngFound)
                Set rngFound = rngToCheck.FindNext(After:=rngFound)
            Loop
        End If
    Next lngCounter
 
    If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
End Sub

If you wanted to only delete for a single keyword you would still have to pass in an array, so you would need to use something like this:

varKeyWords = VBA.Array("Opened Totals")

 

[VBAProIWish]

Colin,

Thanks for the code update.

After analyzing the code, it looks like my only option if I want to use this code is to only use one per module and then call each module.

The way your last code is written, it seems to delete rows without regard to changing worksheets.

What I want is to be able to do this...

1. Select a WS
2. Random code
3. 4. Random code
5. Select a different WS
6. Use the delete macro for the column of my choice and the value(s) of my choice
7. Repeat as necessary


although I see great benefit for future code projects using this method, my current modules just can't delete a whole bunch of rows all at once. Each value must be deleted at an exact time.



For example...

On a WS named "veggies" I might want to eventually delete both "corn" and "potato" but, not before I make a copy of that WS for other reasons somewhere in the middle of the code. Your code, it appears would just delete them all at once. No?

Thanks for all your help.

 

[Colin Legg]

Sorry, but the need select sheets within your code doesn't make sense to me. It's a bad way to do it so I'm not writing or amending any more code.

If you want to be able to interact with the code and choose the keywords to delete at runtime then add some inputbox prompts to the code. I honestly don't think you do that here though - you could just amend the keywords before you run the code.

If you want to create a copy of each sheet then copy each sheet within the loop before deleting rows. If you need to do anything else before the loop moves on to the next sheet then do it within the loop. For example:

For Each wstToCheck In Worksheets(VBA.Array("Totals", "Picked", "Shipped", "Received"))
 
        Set rngToCheck = wstToCheck.Rows(1).Find( _
                                what:=strCOLHEADER, _
                                Lookat:=xlWhole, _
                                SearchOrder:=xlByColumns, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
 
        If Not rngToCheck Is Nothing Then
 
            Select Case VBA.UCase$(wstToCheck.Name)
                Case "TOTALS"
                    varKeyWords = VBA.Array("", "Produce totals", "Product totals")
                Case "PICKED"
                    varKeyWords = VBA.Array("", "Opened Totals")
                Case "SHIPPED", "RECEIVED"
                    varKeyWords = VBA.Array("", "Region totals", "Produce totals")
            End Select
 
            '''''MAKE A BACKUP SHEET OR WHATEVER YOU NEED TO DO HERE
            DeleteRows rngToCheck.EntireColumn, varKeyWords
        End If
 
        ''''''LETS DO SOME OTHER STUFF BEFORE WE MOVE ON TO THE NEXT SHEET
    Next wstToCheck

 

[VBAProIWish]

Colin,

Thank you very much for all that you have done. Being a newbie really stinks sometimes.

For all new code I use, the code you provided will be used anytime I want to delete rows with value(s) in a column. I just think it will be too much effort to go back now.

I tried to anaylize and learn what you have provided to me and it is a little above (at this point) my current scope of understanding and comprehending (like I said, I hate being a newbie ).

I will also look into not having to select a WS to perform a routine. As you have said, and I do believe you, it doesn't seem to be the best way to get things done. I'm sure that sometime in the near future (hopefully), I'll be saying with ease "hey, now I get what Colin means!"


Thanks again

 

[Colin Legg]

Hi,

I'll try to explain what I mean using pseudo code.

I think you are saying that you want to do this:

Select Totals sheet
Take a back up of Totals sheet
Maybe do some stuff on Totals sheet
Delete some rows on Totals sheet
Maybe do some more stuff on Totals sheet
 
Select Picked sheet
Take a back up of Picked sheet
Maybe do some stuff on Picked sheet
Delete some rows on Picked sheet
Maybe do some more stuff on Picked sheet
 
Select Shipped sheet
Take a back up of Shipped sheet
Maybe do some stuff on Shipped sheet
Delete some rows on Shipped sheet
Maybe do some more stuff on Shipped sheet
 
Select Received sheet
Take a back up of Received sheet
Maybe do some stuff on Received sheet
Delete some rows on Received sheet
Maybe do some more stuff on Received sheet

I'm suggesting that my code, which uses a loop, can do exactly the same thing - the structure just looks a little different:

For Each sheet In Sheets called Totals, Picked, Shipped and Received
    Take a back up of the sheet
    Maybe do some stuff on the sheet
    Delete some rows on the sheet
    Maybe do some more stuff on the sheet
Move on to the next sheet

The end result is no different; I'm just using a loop structure to repeat the task rather than writing it out separately for each sheet.

 

[VBAProIWish]

Interesting,

Okay, curve ball here...

So what happens if I place your code at the beginning of the module and part of that code refers to deleting rows on the "Beans" Worksheet


...BUT...

the "Beans" worksheet hasn't yet been created and won't be created until almost at the very end of the module?

Will your code still work properly?

 

[Colin Legg]

It would have to be created before the loop gets round to the "Beans" worksheet; just as, in the first version, it would have to be created before you tried to select it. The creation could be either before the loop structure or within the loop structure.

Neither version can magically reference a sheet that doesn't exist. If the sheet doesn't exist then you'll get a runtime error (in both versions).

 

[VBAProIWish]

Okay, that's what I figured, thanks for the confirmation. The nice thing about the code I posted in the very first post in this thread is that I can "insert" that tiny bit of code in anywhere I want BUT...it is obviously MUCH SLOWER than your code.

Currently, several worksheets are created throughout the mod, so I don't think that option is feasible for me at the present time, but going forward it might be.

Thanks for the dialog though, you are getting me thinking here!