Deleting column if header contains certain text 2

[pendle666]

Hello

In my spreadsheet I want to delete columns which have "pension" contained in any header cells.

[pre]Dim rng As Range
Dim cell As Range
Dim ContainWord As String

'What range do you want to search?
Set rng = Range("A1:HZ1")

'What phrase do you want to test for?
ContainWord = "Pension"

'Loop through each cell in range and test cell contents
For Each cell In rng.Cells
If cell.Find(ContainWord) Then ActiveCell.EntireColumn.Delete

Next cell[/pre]

This is what I have so far, but it's stopping at the If Cell.Find bit. I've used some sites to cobble together what I have but I've come to a dead end. Everything I've looked at is for deleting rows, not columns.



thank you for helping

____________
Pendle

 

[SkipVought]

Hi,

‘Loop through each cell in range and test cell contents
  For Each cell In rng.Cells
    If cell.Find(ContainWord) Then [b]cell[/b].EntireColumn.Delete
    
  Next cell

However, your cell object reference at the moment of Delete, is TOTALLY DESTROYED.

When DELETING rows and columns, you ought to perform a For...Next in reverse to maintain your reference...

‘assuming that the first column is A and the heading are in row 1
For i = ActiveSheet.UsedRange.Columns.Count to 1 Step -1
    With Cells(1, i)
       If .Find(ContainWord) Then .EntireColumn.Delete
    End With
Next

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[pendle666]

Hello

I've replaced the quoted code with the one you gave me but I'm having an error message when running it.

Run time error '91' - Object variable or With block variable not set. The entire code is below and there is a With and End With matching statement.

Sorry if I'm being a dimwit, but I can't see what's wrong.


[pre]Sub NHE_Removecolumns()

Dim rng As Range
Dim cell As Range
Dim ContainWord As String

'What range do you want to search?
Set rng = Range("A1:HZ1")

'What phrase do you want to test for?
ContainWord = "Pension"

'assuming that the first column is A and the heading are in row 1
For i = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
With Cells(1, i)
If .Find(ContainWord) Then .EntireColumn.Delete
End With
Next

End Sub[/pre]

thank you for helping

____________
Pendle

 

[SkipVought]

There is a problem with your FIND.

Here's a differnt approch

Sub NHE_Removecolumns()
    Dim rng As Range
    Dim ContainWord As String


'What phrase do you want to test for?
    ContainWord = "Pension"

'assuming that the heading are in row 1
    With Intersect(ActiveSheet.UsedRange, Rows(1))
        Set rng = .Find(ContainWord)
    
        If Not rng Is Nothing Then
            Do
                rng.EntireColumn.Delete
            
                Set rng = .FindNext
                
                If rng Is Nothing Then Exit Do
            Loop
        End If
    End With

End Sub

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[pendle666]

Excellent - that's worked perfectly.


thank you

thank you for helping

____________
Pendle

 

[pendle666]

This macro is a godsend - thank you so much.

However, I'm wondering if it's possible to remove several columns at once?

There is a line which asks for the word to delete -

[pre] ContainWord = "Pension"[/pre]


But what if I wanted to get rid of all columns with not only "pension" in the title but also "overtime"?

I've tried:

[pre]
ContainWord = "Pension"
ContainWord = "Overtime"[/pre]

But that didn't remove anything. Is this something that can be done? I'm formatting a spreadsheet which goes from column A to column CS so it would be good to get rid of everything I don't need without checking each column.

thanks in advance!



thank you for helping

____________
Pendle

 

[Andrzejek]

You may just do very [blue]slight modification[/blue] to Skip's code:

Option Explicit
[blue]
Sub RemoveMultiColumns()
Dim strRem(4) As String
Dim i As Integer

strRem(0) = "Pension"
strRem(1) = "Overtime"
strRem(2) = "Sick"
strRem(3) = "Vacation"
strRem(4) = "GoofingOff"

For i = LBound(strRem) To UBound(strRem)
    Call NHE_Removecolumns(strRem(i))
Next i

End Sub
[/blue]
Sub NHE_Removecolumns([blue]ByRef strWord As String[/blue])
    Dim rng As Range
    Dim ContainWord As String
[green]
'What phrase do you want to test for?[/green]
    ContainWord = [blue]strWord[/blue]
[green]
'assuming that the heading are in row 1[/green]
    With Intersect(ActiveSheet.UsedRange, Rows(1))
        Set rng = .Find(ContainWord)
    
        If Not rng Is Nothing Then
            Do
                rng.EntireColumn.Delete
                Set rng = .FindNext
                If rng Is Nothing Then Exit Do
            Loop
        End If
    End With
End Sub

---- Andy

There is a great need for a sarcasm font.

 

[pendle666]

That's great, thank you

thank you for helping

____________
Pendle