Want to delete every worksheet that *doesn't* contain one of several phrases

[Televangelist]

Hi all,

I've got a problem that I've had trouble finding a solution for using Google-Fu.

In short, I want to have a macro or otherwise automatable solution that deletes a worksheet if it doesn't contain either Phrase A, Phrase B, Phrase C, or Phrase D. (any of the four phrases will do.)

Can VBA do this?

Since I use a lot of ASAP Utilities and AutoHotKey, I can automate the 'outer shell' pretty easily if I can figure out the most basic step: How do I have Excel check whether or not a cell contains a given line of text?

Ideally, this would simply be an '=IF' statement. But I can't seem to put one together that answers this.


Or could I filter sheets based on whether or not they have one of the phrases, and then copy only the sheets still displayed?


Not sure how to go about handling this.

 

[Ralajer]

Welcome to the board Televangelist,

The below code will work once you change it for you specific phrases and cell reference.

Sub deleteWSWithoutPhrases()

    Dim Phrases As Variant
    Dim ws As Worksheet
    Dim s As Variant
    Dim keep As Boolean
    Application.DisplayAlerts = False
    
    Phrases = Array("Phrase A", "Phrase B", "Phrase C", "Phrase D")

    For Each ws In Worksheets
        '// Reset Default to false
        keep = False
        For Each s In Phrases
            keep = ws.Range("A1").Value = s
            If keep Then Exit For
        Next s
        
        '// Special Check to prevent the last worksheet to be deleted
        If keep = False And Worksheet.Count = 1 Then
            MsgBox "One worksheet remains and it can't be deleted."
            Exit Sub
        End If
        If keep = False Then ws.Delete
    Next ws
    Application.DisplayAlerts = True

End Sub

 

[Televangelist]

Thank you very much, Rob! That looks perfect.

I feel like a bit of a jerk asking a follow-up question after you just managed what four hours on Google wasn't able to, but... does Excel provide a way for me to load this code in some sort of 'universal' way, as opposed to putting it into a macro for one specific data-sheet, accessible by a keystroke combination?


The goal would be that pressing, say, CTRL+ALT+SHIFT+* in any worksheet I open in Excel would run this macro.


That way, with AutoHotKey, I can have it open each file, run the script and then do a few other things, close the file, go down to the next file, ad infinitum.

Again, much appreciated!

 

[Ralajer]

There is nothing jerky about asking a follow-up question but TWO follow-up questions is eminently jerky. So only read one of the following answers.

To run the macro on any workbook you have to put the code in the personal macro workbook, which is a hidden workbook that gets opened when you open Excel. In the VBA editor in the Project Pane (Ctrl+R if not visible) there will be file called either Personal.xls or Personal.xlsb depending on you version. Right on it click select Insert -> Module -> Paste code there. It is possible that the Personal.xls* workbook might not be there. If it is not let me know.

To assign a shortcut key in Excel open the Macro Dialog Box (Alt+F8) find the macro in the list, select it, press the option button and assign the desired keyboard combo. Using this method the keyboard combo is limited to "Ctrl+Shift+" there are probably other ways to capture key strokes but I don't know what they are.

 

[Televangelist]

So far, so good!

I plugged in the macro, and edited the range as you suggested.

That line now reads:

keep = ws.Range("A1:Z100").Value = s

Since that range (A1 to Z100) will encompass all the data that needs to be checked on each sheet, and then some.

Unfortunately, I get a "type mismatch" error now every time I try to run the script, and it points to that line. Any idea what might be causing that?

 

[Ralajer]

Since you are dealing with a range of values and not a single cell then the approach will have to be changed slightly.

Sub deleteWSWithoutPhrases()

    Dim Phrases As Variant
    Dim ws As Worksheet
    Dim s As Variant
    Dim keep As Boolean
    Dim found As Range
    Application.DisplayAlerts = False
    
    Phrases = Array("Phrase A", "Phrase B", "Phrase C", "Phrase D")

    For Each ws In Worksheets
        '// Reset Defaults
        keep = False
        Set found = Nothing
        For Each s In Phrases
            Set found = ws.Cells.Find( _
                        What:=s, LookIn:=xlValues, _
                        [COLOR="red"]LookAt:=xlPart[/COLOR], [COLOR="Red"]MatchCase:=False[/COLOR])
            If Not found Is Nothing Then
                keep = True
                Exit For
            End If
        Next s
        
        '// Special Check to prevent the last worksheet from being deleted
        If keep = False And Worksheets.Count = 1 Then
            MsgBox "One worksheet remains and it can't be deleted."
            Exit Sub
        End If
        If keep = False Then ws.Delete
    Next ws
    Application.DisplayAlerts = True
End Sub

Should have asked to earlier. Does the match have to be case sensitive and/or does the phrase(s) have to match the whole content of the cell? The above doesn't require either so for example

[B3] = text phrAse d text​

would be a valid match and the sheet wouldn't be deleted. Let me know if that works but it only minor change to make it more stringent. Those changes being
For case sensitivity
• MatchCase:=False to MatchCase:=True
For matching whole content
• LookAt:=xlPart to LookAt:=xlWhole

EDIT: Changed it to search the whole sheet rather than only the range A1:Z100.

 

[Televangelist]

Thanks, Rob!

I'm not worried about case sensitivity; my problem is actually that my search terms are unicode characters, and I didn't realize that would be a problem with VBA! I've found a 'converter' that seems to handle that, though, so hopefully that won't be a continued impediment.

 

[Televangelist]

This is just a quick update for anyone who comes across this thread via Google looking for a solution to their problem:

To use Unicode characters in this Excel code, I had to remove the quotes.

For example, I ran the phrase "股东" ('gudong', shareholder) through an Excel converter, and it gave me ChrW$(&H80A1) & ChrW$(&H4E1C) as the converted VBA text.

So far, so good!

But when I tried the following modification of Rob's code, it didn't work:

Phrases = Array("ChrW$(&H80A1) & ChrW$(&H4E1C)", "Phrase B", "Phrase C", "Phrase D")

What I had to do was remove the quotes.

The following code worked like a charm:

Phrases = Array(ChrW$(&H80A1) & ChrW$(&H4E1C), "Phrase B", "Phrase C", "Phrase D")


So, hope that's of use to anyone else who comes across a similar issue!