CODEWITHSUNDEEP
excelvbadynamicformattingconditional-statements
Andy_85
Andy_85

Reputation: 29

Conditional Formatting using VBA, Dynamically styling a range by referring to another cell for the formatting

Here's my problem.

enter image description here

So, applied to the range K3:K10, I have several different conditional formatting rules that require a specific text string comprised of the contents of a referenced cell plus a constant text string. Each rule applies a different colour for a specific referenced cell and constant text string (DEAD or ALIVE) combination. For example, in the range, if a cell contains the word "Dog", then a space, and then the word "Dead", it will be formatted Red. The legend in columns D and E show what colours apply to each animal for the combination of criteria (Animal and Dead/Alive). What I want to do is, to be able to choose a colour for an animal with a drop down list in Column C, and have the CF change the formatting of any of the cells within the range K3:K10 to match the formatting/style of the relevant row in column C when a particular rule is true.

So, if K3 is "Dog Dead", then apply the same formatting as in cell D3 or if it is "Dog Alive" apply the same formatting as E3. I don't want to just ask CF to make any cell containing "Dog Dead" red or "Dog Alive" light red, because the colour for dog might not be red. It could be green, or blue.

So, I guess I want to achieve dynamic conditional formatting using VBA I think. Can someone help me get started?

Thanks,

Andy.

Upvotes: 0

Views: 2332

Answers (1)

user3514930
user3514930

Reputation: 1717

Starting Point !!
In the Sheet event:

Private Sub Worksheet_Change(ByVal Target As Range)
    ApplyCond Range("K" & Target.Row)
End Sub

And in a Module:

Public Sub ApplyCond(xx As Range)
    If xx.Value = "" Then Exit Sub
    xx.FormatConditions.Delete
    xx.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:=xx.Value
    kk = Split(xx.Value)
    a = -1
    b = -1
    For i = LBound(kk) To UBound(kk)
        Select Case kk(i)
        Case "Dead": a = 4
        Case "Alive": a = 5
        Case Else
            For e = 3 To 9999
                If Range("B" & e).Value = "" Then Exit For
                If Range("B" & e).Value = kk(i) Then
                    b = e
                End If
            Next
        End Select
    Next

    ' Apply Format
    On Error Resume Next
    If (a > 0) And (b > 0) Then
        With xx.FormatConditions(1).Interior
            .PatternColorIndex = Cells(b, a).Interior.PatternColorIndex
            .Color = Cells(b, a).Interior.Color
            .TintAndShade = Cells(b, a).Interior.TintAndShade
            .Pattern = Cells(b, a).Interior.Pattern
            .PatternThemeColor = Cells(b, a).Interior.PatternThemeColor
            .ThemeColor = Cells(b, a).Interior.ThemeColor
            .PatternTintAndShade = Cells(b, a).Interior.PatternTintAndShade
        End With
        With xx.FormatConditions(1).Font
            .Bold = Cells(b, a).Font.Bold
            .Italic = Cells(b, a).Font.Italic
            .Underline = Cells(b, a).Font.Underline
            .Strikethrough = Cells(b, a).Font.Strikethrough
            .ThemeColor = Cells(b, a).Font.ThemeColor
            .TintAndShade = Cells(b, a).Font.TintAndShade
            .Color = Cells(b, a).Font.Color
            .TintAndShade = Cells(b, a).Font.TintAndShade
        End With
    End If
End Sub

You need to verify the Split formula. Perhaps it's better to use a LCase function or other filter.
In my function I don't use the column "C".

Upvotes: 0

Related Questions