PDA

View Full Version : Solved: Column Heading Search



mzsuga
06-22-2009, 10:10 AM
The macro below only searches through column X. How do I get it to search through all the columns?

Dim cStay As Variant
Dim rDel As Range
Dim rCell As Range
Dim i As Long
Dim bStay As Boolean
cStay = Array("Assumption Group", "List Name", "Select", "Comments", "Key", "List Type", "Subject Category", _
"Total Order Qty", "Global Adj Dupe %", "Total Mail QTY", "Resp %", "Donors", "Avg Don$", "Grs$", "Total List Cost", _
"Promo Cost", "Total Cost", "Cost/ Donor (P/L)", "LT Rev/Mbr")
For Each rCell In Range(Cells(2, 1), _
Cells(2, Columns.Count).End(xlToLeft))
With rCell
For i = 0 To UBound(CStay)
If .Value = cStay(i) Then
bStay = True
Exit For
End If
Next i
If Not bStay Then
If rDel Is Nothing Then
Set rDel = .Cells
Else
Set rDel = Union(rDel, .Cells)
End If
Else
bStay = False
End If
End With
Next rCell
If Not rDel Is Nothing Then rDel.EntireColumn.Delete

tpoynton
06-22-2009, 12:18 PM
hard to tell without a sample workbook; searched through 60 columns in a test file I put together. try putting a counter in to see how many cells it is looping through in the range?

also, the title says 'column heading search', but you are searching row 2; is that right?

stanleydgrom
06-22-2009, 12:26 PM
mzsuga,

Try:


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).




Option Explicit
Option Base 1
Sub DeleteColumns()
Dim a As Long, i As Long, LC As Long, DelC As Long
Dim cStay As Variant
Application.ScreenUpdating = False
cStay = Array("Assumption Group", "List Name", "Select", "Comments", _
"Key", "List Type", "Subject Category", "Total Order Qty", _
"Global Adj Dupe %", "Total Mail QTY", "Resp %", "Donors", _
"Avg Don$", "Grs$", "Total List Cost", "Promo Cost", "Total Cost", _
"Cost/ Donor (P/L)", "LT Rev/Mbr")
LC = Cells(2, Columns.Count).End(xlToLeft).Column
For a = LC To 1 Step -1
DelC = 0
For i = 1 To UBound(cStay)
If Cells(2, a) = cStay(i) Then DelC = DelC + 1
Next i
If DelC = 0 Then Cells(2, a).EntireColumn.Delete
Next a
Application.ScreenUpdating = True
End Sub





Then run the "DeleteColumns" macro.

mzsuga
06-22-2009, 01:01 PM
hard to tell without a sample workbook; searched through 60 columns in a test file I put together. try putting a counter in to see how many cells it is looping through in the range?

also, the title says 'column heading search', but you are searching row 2; is that right?

Correct because the column headings are in row 2

mzsuga
06-22-2009, 01:02 PM
mzsuga,

Try:


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).




Option Explicit
Option Base 1
Sub DeleteColumns()
Dim a As Long, i As Long, LC As Long, DelC As Long
Dim cStay As Variant
Application.ScreenUpdating = False
cStay = Array("Assumption Group", "List Name", "Select", "Comments", _
"Key", "List Type", "Subject Category", "Total Order Qty", _
"Global Adj Dupe %", "Total Mail QTY", "Resp %", "Donors", _
"Avg Don$", "Grs$", "Total List Cost", "Promo Cost", "Total Cost", _
"Cost/ Donor (P/L)", "LT Rev/Mbr")
LC = Cells(2, Columns.Count).End(xlToLeft).Column
For a = LC To 1 Step -1
DelC = 0
For i = 1 To UBound(cStay)
If Cells(2, a) = cStay(i) Then DelC = DelC + 1
Next i
If DelC = 0 Then Cells(2, a).EntireColumn.Delete
Next a
Application.ScreenUpdating = True
End Sub




Then run the "DeleteColumns" macro.

I want this to be part of a macro that I already have, so I don't want another sub (), how do I incorporate that into the macro I already have?

mzsuga
06-22-2009, 01:11 PM
Okay guys, never mind, I figured it out, the problem was that one of my columns were mislabeled.


Thank you though!!!

mzsuga
06-23-2009, 07:07 AM
I get a compile error of For without Next, help please


Sub test()


Dim sFilename As Variant

sFilename = Application.GetOpenFilename
If sFilename <> False Then
Workbooks.Open (sFilename)


With Worksheets("Assumptions")
Set r1 = Range("c2:c4")
r1.Copy
ActiveSheet.Paste Destination:=Worksheets("Mail Plan Details").Range("fz2")



'Selects the unnecessary sheets and deletes them
Dim wks As Worksheet
Application.DisplayAlerts = False
For Each wks In Worksheets
If wks.Name <> "Mail Plan Details" Then wks.Delete
Application.DisplayAlerts = True

Dim cStay As Variant
Dim rDel As Range
Dim rCell As Range
Dim i As Long
Dim bStay As Boolean
cStay = Array("Assumption Group", "List Name", "Select", "Comments", "Key", "List Type", "Subject Category", "Total Order Qty", "Global Adj Dupe %", "Total Mail QTY", "Resp %", "Donors", "Avg Don$", "Grs$", "Total List Cost", "Promo Cost", "Total Cost", "Cost/ Donor (P/L)", "userfield1")
For Each rCell In Range(Cells(2, 1), _
Cells(2, Columns.Count).End(xlToLeft))
With rCell
For i = 0 To UBound(cStay)
If .Value = cStay(i) Then
bStay = True
Exit For
End If
Next i
If Not bStay Then
If rDel Is Nothing Then
Set rDel = .Cells
Else
Set rDel = Union(rDel, .Cells)
End If
Else
bStay = False
End If
End With
Next rCell
If Not rDel Is Nothing Then rDel.EntireColumn.Delete

Dim c As Range
For Each c In ActiveSheet.UsedRange
c = Replace(c, "userfield1", "LT REV/Mbr")

End Sub

tpoynton
06-23-2009, 07:24 AM
that's because you have a FOR statement (or two) without the required NEXT...be sure that each for loop has an ending next, and that each with statement has an end with.

Syntax is 'for each CellVariable in range...(do stuff)...next cellVariable

also consider declaring all of your variables at the top of the sub, and using option explicit.