Delete all Columns with a certain value

[axwack]

Hello All,

This is a real newbie question and there have been a few posts with
code but they don't work for me.

I need to look for columns that have the following in its cell: "c:/
bitmaps/exclaim.gif"

If there is an occurence of this in the cell, delete the column and
all other columns that have this value in it.

Can anyone help me with this?

 

[Guest]

Try this. I've included some debug.print in case you want to see what's
happening.

Sub Test()
Dim myRange As Range, myDeleteRange As Range, r As Range
Dim lCol As Long, lrow As Long
Dim aWS As Worksheet

Set aWS = ActiveSheet


Set myRange = Cells(1, aWS.Columns.Count).Resize(aWS.Rows.Count, 1)
Debug.Print myRange.Address
lCol = myRange.End(xlToLeft).Column

Set myRange = aWS.Cells(aWS.Rows.Count, 1).Resize(1, aWS.Columns.Count)
Debug.Print myRange.Address
lrow = myRange.End(xlUp).Row

Set myRange = Cells(1, 1).Resize(lrow, lCol)
Debug.Print myRange.Address

Set myDeleteRange = Nothing
For Each r In myRange
If r.Value = "c:/bitmaps/exclaim.gif" Then
If myDeleteRange Is Nothing Then
Set myDeleteRange = r
Else
Set myDeleteRange = Union(myDeleteRange, r)
End If
End If
Next r

Debug.Print myDeleteRange.Address

If Not myDeleteRange Is Nothing Then
myDeleteRange.EntireColumn.Delete
End If
End Sub

 

[Dave Peterson]

Another...

Option Explicit
Sub testme()

Dim myStr As String
Dim FoundCell As Range
Dim wks As Worksheet

Set wks = ActiveSheet

'I changed to backslashes.
'change it back if you need to.
myStr = "c:\bitmaps\exclaim.gif"

With wks
Do
Set FoundCell = .Cells.Find(what:=myStr, _
after:=.Cells(.Cells.Count), _
lookat:=xlWhole, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=False)

If FoundCell Is Nothing Then
'done
Exit Do
Else
FoundCell.EntireColumn.Delete
End If

Loop
End With

End Sub


It just does a bunch of edit|find's and deletes the column if the find is
successful.

 

[Guest]

Here is another one if you want to try different techniques.

Sub gifDel()
For Each Column in ActiveSheet.Columns
Set c = Cells.Find("c:/bitmaps/exclaim.gif", LookIn:=xlValues)
If Not c Is Nothing Then
fRng = c.Address
Range(fRng).EntireColumn.Delete
End If
Next
End Sub