List of "find what" delete column

[psrs0810]

I have 27 different titles I am finding then deleting using a long list of:

Cells.Find(What:="C1S", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Selection.EntireColumn.Select
Selection.Delete

How can shorted the list?

 

[mikerickson]

Perhaps something like

Dim foundCell as Range
Dim oneSearchTerm as Variant

For Each oneSearchTerm in Array("C1S", "C2S", "Bxf")
    Do
        Set foundCell = Cells.Find(What:=oneSearchTerm, After:=ActiveCell, _
            LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        If foundCell Is Nothing then
            foundCell.EntireColumn.Delete
        End If
    Loop Until (foundCell Is Nothing)
Next oneSearchTerm

 

[psrs0810]

The macro seems to loop non stop with out deleting anything

 

[mikerickson]

I was testing the wrong condition for deletion.

Sub test()
Dim foundCell As Range
Dim oneSearchTerm As Variant

For Each oneSearchTerm In Array("dog", "C2S", "goat")
    Do
        Set foundCell = Cells.Find(What:=oneSearchTerm, After:=ActiveCell, _
            LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
       [COLOR="Red"] If Not (foundCell Is Nothing) Then[/COLOR]
            foundCell.EntireColumn.Delete
        End If
    Loop Until (foundCell Is Nothing)
Next oneSearchTerm
End Sub

 

[psrs0810]

that's better.

Hey, what can I add so that it only looks a column C and everything to the right?

When I ran the maco it must have found another cell that I need to keep (which is in column B)

 

[mikerickson]

Sub test()
Dim foundCell As Range
Dim oneSearchTerm As Variant

For Each oneSearchTerm In Array("dog", "C2S", "goat")
    Do
        With ActiveSheet
            Set foundCell = Range(.Cells(3, 1), .Cells(.Rows.Count, .Columns.Count)).Find(What:=oneSearchTerm, After:=.Cells(3,1), _
                LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
            If Not (foundCell Is Nothing) Then
                foundCell.EntireColumn.Delete
            End If
        End With
    Loop Until (foundCell Is Nothing)
Next oneSearchTerm
End Sub

 

[psrs0810]

I see that you added in (.Cells(3, 1 to look at column C, but it still deleted the info in column B.

 

[mikerickson]

Oh, it would help if I got rows and columns in the right place.

Sub test()
Dim foundCell As Range
Dim oneSearchTerm As Variant

For Each oneSearchTerm In Array("dog", "C2S", "goat")
    Do
        With ActiveSheet
            Set foundCell = Range(.Cells(1, 3), .Cells(.Rows.Count, .Columns.Count)).Find(What:=oneSearchTerm, _
                After:=.Cells(1, 3), _
                LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
            If Not (foundCell Is Nothing) Then
                foundCell.EntireColumn.Delete
            End If
        End With
    Loop Until (foundCell Is Nothing)
Next oneSearchTerm
End Sub

 

[psrs0810]

there we go!!!

I should have picked up that the rows/columns were mixed up.

thanks for your help