Column Header VBA tweak

[end922]

Greetings, I have some code that would like to tweak and have it perform better.
Previously a VLookup has identified which columns to keep.
Then I delete all the others with the macro. There are 60 columns in all.

Not sure what I can do.

Sub Listonly()
Dim i As Long, LC As Long
Dim hdr As String

LC = Range("IV1").End(xlToLeft).Column

For i = LC To 1 Step -1
hdr = Cells(1, i)
If InStr(hdr, "Keep") = 0 Then
Columns(i).Delete
End If
Next i

End Sub

Thanks
Eric

 

[SkipVought]

Not much...

Sub Listonly()
    Dim i As Integer
    
    For i = Range("IV1").End(xlToLeft).Column To 1 Step -1
        With Cells(1, i)
            If InStr(.Value, "Keep") = 0 Then .EntireColumn.Delete
        End With
    Next i
End Sub

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[end922]

They are both about the same. Appreciate it.
I don't know how you did that so fast. I've working on it all day.

 

[SkipVought]

Eat, sleep & drink it.

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[end922]

I hear ya. Have another question for you please.
In my sheet at the bottom of colmn B I want to type in the bottom cell, Complete, then down one, On Target, then down one, Close to Late, then down one, Late.
I recorded a macro that basically gets me to the last populated cell but how do I tell it to move down one, then do my typing, then down another and so on.

Sub fcolor()
'
' fcolor Macro
' Macro recorded 2/4/2009 by eric

    Range("B2").Select
    Selection.End(xlDown).Select
       
End Sub

 

[PHV]

Have a look at the Offset property.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[end922]

looks like the right direction.
Thanks
Eric

 

[end922]

Hey Guys, another question, I was able to move the bottom of the sheet then move down cell by cell, type and format my data. I then moved up 5 rows and 1 column to the right. Now I need to type in a formula that counts the number of cells above my active cell in col C that are the same color as the one to the left of my active cell.
I have the function to do that, that is not a problem. The problem is telling my function to look at the cell to the left and all the cells up from there. The spreadsheet can grow and shirnk. Any suggestions?

Thanks
Eric

Public Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As Boolean)

    Dim rcell As Range

    Dim lCol As Long

    Dim vResult

''''''''''''''''''''''''''''''''''''''
'Written by Ozgrid Business Applications
'[URL unfurl="true"]www.ozgrid.com[/URL]
'Sums or counts cells based on a specified fill color.
'''''''''''''''''''''''''''''''''''''''
    lCol = rColor.Interior.ColorIndex
    If SUM = True Then
        For Each rcell In rRange
            If rcell.Interior.ColorIndex = lCol Then
                vResult = WorksheetFunction.SUM(rcell, vResult)
            End If
        Next rcell
    Else
        For Each rcell In rRange
            If rcell.Interior.ColorIndex = lCol Then
                vResult = 1 + vResult
            End If
        Next rcell
    End If
   ColorFunction = vResult
End Function

 

[SkipVought]

a different question ought to be in a NEW thread.

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[PHV]

Have a look at the Offset property

 

[SkipVought]

this might work for you...

Public Function ColorFunction(rColor As Range, Optional SUM As Boolean)

    Dim rCell As Range

    Dim lCol As Long

''''''''''''''''''''''''''''''''''''''
'Written by Ozgrid Business Applications
'[URL unfurl="true"]www.ozgrid.com[/URL]
'Sums or counts cells based on a specified fill color.
'''''''''''''''''''''''''''''''''''''''
    lCol = rColor.Interior.ColorIndex
    
    Set rCell = rColor.Offset(0, -1)
    Do
        If rCell.Interior.ColorIndex = lCol Then
            If SUM Then
                ColorFunction = rCell.Value + ColorFunction
            Else
                ColorFunction = 1 + ColorFunction
            End If
        End If
        Set rCell = rCell.Offset(-1)
    Loop Until rCell.Row = 1
    set rCell = Nothing
End Function

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}