# Solved: Excel Macro -> Delete Multiple Columns Based on Criteria



## computerman29642 (Dec 4, 2007)

I need to delete multiple columns within an Excel worksheet based on the headers in the first row. What would be the best way to perform this operation?

I have been playing around with the code below, but I feel as though there could be a better way.

Sub test()

Dim myArr As Variant

myArr = Array("Test1", "Test2", "Test3")


If Range("C1").Value = myArr Then
Columns("C").Delete shift:=xlToLeft
ElseIf Range("D1").Value = myArr Then
Columns("D").Delete shift:=xlToLeft
End If

End Sub


----------



## bomb #21 (Jul 1, 2005)

Is myArr unique in row 1? Because if C1 *and* D1 = myArr, only C1 gets cut. I think.


----------



## computerman29642 (Dec 4, 2007)

If you mean by unique that the headers do not duplicate, then yes the values of myArr are unique.

I also have been playing around with this code.

Dim Rng As Range
Dim I As Long
Dim myArr As Variant

myArr = Array("Test1", "Test2", "Test3")
For I = LBound(myArr) To UBound(myArr)

ActiveSheet.Range("A:O").AutoFilter Field:=3, Field:=4, Criteria1:=myArr(I)
With ActiveSheet.AutoFilter.Range
Set Rng = Nothing
On Error Resume Next
Set Rng = .Offset(1, 0).Resize(.Columns.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not Rng Is Nothing Then Rng.EntireColumn.Delete
End With
Next I
ActiveSheet.AutoFilterMode = False

The code does not work correctly.

Both codes slide the columns left after deletion. Is there a way to delete the columns at the same time?


----------



## bomb #21 (Jul 1, 2005)

You confused me. "slide the columns" suggests >1 column may get cut.

Either way I'd replace in the header row with blanks, then use:

SpecialCells(xlCellTypeBlanks).EntireColumn.Delete

In fact, try that for me so I know I'm not going bonkers w/r/t that other thread. Something _like_:

Sub Macro2()
Rows(1).Replace What:="xyz", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Rows(1).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
End Sub


----------



## computerman29642 (Dec 4, 2007)

Bomb I did not mean to confuse you. When I said "slide the columns left", I meant to say "shift the columns left" after a column had been deleted.


----------



## computerman29642 (Dec 4, 2007)

Bomb, I gave this a try, but it did not work:

Dim myArr As Variant

myArr = Array("Test1", "Test2", "Test3")

Rows(1).Replace What:=myArr, Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Rows(1).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete


----------



## bomb #21 (Jul 1, 2005)

Post a sample.


----------



## computerman29642 (Dec 4, 2007)

Sample file attached.


----------



## computerman29642 (Dec 4, 2007)

I believe I have found a way to delete the columns not needed. I have come up with this code:

Range("S:S,R:R,P,O:O,M:M,L:L,J:J,I:I,G:G,F:F,D,C:C").Delete Shift:=xlToLeft

It starts from the right of teh spreadsheet, and moves left.

If anyone has a better idea, please feel free to let me know.


----------



## computerman29642 (Dec 4, 2007)

What would be the best way to add all the color numbers together, and then add all the black numbers together?


----------



## bomb #21 (Jul 1, 2005)

What's the criterion for column deletion?; row 2 value = 0?


----------



## computerman29642 (Dec 4, 2007)

Some of the columns are not needed, and others if all the cells are populated with "Unlimited".


NOTE: The attached file does not contain all the columns, and the real column headers.


----------



## bomb #21 (Jul 1, 2005)

computerman29642 said:


> What would be the best way to add all the color numbers together, and then add all the black numbers together?


With code, or ... ?

Sub test2()
x = WorksheetFunction.CountA(Rows(1))
For Each Cell In Range("B1").Resize(, x)
If Cell = "Color" Then
ColNo = Cell.Column
y = y + WorksheetFunction.Sum(Columns(ColNo))
End If
Next Cell
MsgBox "Sum of color numbers = " & y & "."
End Sub

?


----------



## computerman29642 (Dec 4, 2007)

bomb #21 said:


> With code, or ... ?
> 
> Sub test2()
> x = WorksheetFunction.CountA(Rows(1))
> ...


I was planning on doing this with a formula, but if you think code would be better that would work for me.

The problem I am running into is that the Column Headers are not as simple as the attached file indicates. The words "Color" and "Black" could appear in the middle of the header, at the end of the header, or at the beginning of the header.


----------



## computerman29642 (Dec 4, 2007)

I was able to come up with these two formulas:

=SUMIFS(E22,$E$1:$P$1,"*Color*")
=SUMIFS(E22,$E$1:$P$1,"*Black*")


----------

