CODEWITHSUNDEEP
vbaexcel
bhinton
bhinton

Reputation: 13

How to conditional format data in multiple columns by hardcoding what the column's header name is?

I'm looking to run a series of conditional formatting rules on two columns of data. I know I can select a column letter and all the cells in that columns, but to make my macro more full-proof I'd like for it to search for the column's header and run the formatting on the cells below the two specific headers.

I Currently used the Record Macro tool to see how this could potentially work, and this is my current setup. This macro does work, I would just like to make it full-proof and search through the worksheet for the specific column title names. I'd like to search a woorksheet for the column Titles "Header 1" and "Header 2".

Sub TwoColumnConditional()
    Columns("K:AJ").Select
    Selection.FormatConditions.Add Type:=xlTextString, String:="CONTAINSTEXT1", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlTextString, String:="CONTAINSTEXT2", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16751204
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 10284031
        .TintAndShade = 0
    End With
End Sub

Upvotes: 0

Views: 1280

Answers (1)

L42
L42

Reputation: 19727

Try this:

Sub ApplyCF()

Dim ws As Worksheet
Dim rng As Range, fcel As Range, hrng As Range
Dim myheaders, header
Dim mycondition As String

myheaders = Array("Header 1", "Header 2")

Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
    Set rng = .Range("A1", .Range("A1").Offset(0 _
        , .Columns.Count - 1).End(xlToLeft).Address)
    'Debug.Print headers.Address
End With

For Each header In myheaders
    Set fcel = rng.Find(header, rng.Cells(rng.Cells.Count))
    If Not fcel Is Nothing Then
        If hrng Is Nothing Then
            Set hrng = fcel.EntireColumn
        Else
            Set hrng = Union(hrng, fcel.EntireColumn)
        End If
    End If
Next
'Debug.Print hrng.address

hrng.FormatConditions.Add Type:=xlTextString, String:="CONTAINSTEXT1", _
    TextOperator:=xlContains
With hrng.FormatConditions(hrng.FormatConditions.Count)
    With .Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With .Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    .StopIfTrue = False
End With

hrng.FormatConditions.Add Type:=xlTextString, String:="CONTAINSTEXT2", _
    TextOperator:=xlContains
With hrng.FormatConditions(hrng.FormatConditions.Count)
    With .Font
        .Color = -16751204
        .TintAndShade = 0
    End With
    With .Interior
        .PatternColorIndex = xlAutomatic
        .Color = 10284031
        .TintAndShade = 0
    End With
    .StopIfTrue = False
End With

End Sub

I only assumed your headers are in the first row.
Adjust the code to suit.

Upvotes: 1

Related Questions