0

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
Community
  • 1
  • 1
bhinton
  • 13
  • 1
  • 9
  • You can set up a routine which will look for the header. Once you've done that, you can use `.ModifyAppliesToRange` method to assign the formatting on your desired column. See [THIS](http://stackoverflow.com/questions/22500483/conditional-formatting-using-3-conditions-in-macro-vb/22501780#22501780) post which will give you an example of how it is done. – L42 Apr 24 '14 at 02:21

1 Answers1

1

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.

L42
  • 19,427
  • 11
  • 44
  • 68
  • I get an run-time error message stopping the macro at "hrng.FormatConditions.Add Type:=xlTextString, String:="CONTAINSTEXT1", _" any ideas why? – bhinton Apr 24 '14 at 18:45
  • I changed the ws = Activesheet to run the macro on the specified sheet I was working on. – bhinton Apr 24 '14 at 19:16
  • Where did you put the code? It should be in a module. – L42 Apr 24 '14 at 22:13