CODEWITHSUNDEEP
excelvba
Aurelius
Aurelius

Reputation: 485

VBA to seach for multiple criteria, and delete the columns that do not contain these criteria

I have put together the below, but I am not familiar with VBA, so it obviously doesn't work.

Sub DeleteUneededColumn()
Dim FindString As String
Dim Rng As Range
FindString = "Type"
If Trim(FindString) <> "" Then
    With Sheets("page 1").Range("A:ZZ")
        Set Rng = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Rng Is Nothing Then
            Rng.EntireColumn.Delete
        End If
    End With
End If
End Sub

As per the title, it needs to find multiple criteria (Ideally based on some keywords I have entered in cells A1:A3 on Sheet1), I tried to get it working with just one first but no joy. Then, for every column in page 1 that doesn't contain these words, delete that column.

I understand .Find is going to be a big part of it but not sure on the rest.

Upvotes: 0

Views: 64

Answers (1)

jivko
jivko

Reputation: 430

Find returns the range with first occurrence where the string is found and you're searching the full range.

I modified your code so it goes column by column and collects all columns where the string is not found, then deletes that range.

Sub DeleteUneededColumn()

Dim FindString As String
Dim Rng As Range

FindString = "C"

Dim rngCol As Range, rngDelete As Range

For Each rngCol In Range("A:ZZ").Columns
    Set Rng = rngCol.Find(What:=FindString, _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
    If Rng Is Nothing Then
        If rngDelete Is Nothing Then
            Set rngDelete = rngCol
        Else
            Set rngDelete = Union(rngDelete, rngCol)
        End If
    End If

Next

rngDelete.Delete

End Sub

Upvotes: 1

Related Questions