CODEWITHSUNDEEP
vbaformattingconditional-statements
Lionel Justafre
Lionel Justafre

Reputation: 1

vba Conditional Formatting based on formulas

I want a simple color code on quite a large spreadsheet (several hundreds cells to color). If I use CF it slows the computer and Excel just crashes. I want to try and do it with VBA. I tried the below code but it only works if I type the value (being 1, 2 or 3). It doesn't work if the value if the result of a formula. Any idea?

Private Sub Worksheet_Change(ByVal Target As Range)

Dim icol As Integer, c As Range, rng As Range

If Target.Count > 1 Then Exit Sub

Set rng = Range("D2:s1000")

If Intersect(Target, rng) Is Nothing Then Exit Sub

For Each c In Intersect(Target, rng)

    Select Case UCase(c.Value)
        Case 1: icol = 3
        Case 2: icol = 4
        Case 3: icol = 18
        Case Else: icol = 0
    End Select
    c.Interior.ColorIndex = icol
Next c
End Sub

If Jean Francois Corbett could answer that would be great!

Upvotes: 0

Views: 310

Answers (1)

Dale M
Dale M

Reputation: 2473

@TimWilliams is correct, however, you can recurively expand the target range to include target.dependants like

Private Function TargetDependents(ByRef Target As Range) As Range
    Dim c As Range

    If Not Target.Dependents Is Nothing Then
        Set TargetDependents = Union(Target, Target.Dependents)
    End If

    If TargetDependents.Cells.Count > Target.Cells.Count Then
        TargetDependents = TargetDependents(TargetDependents)
    End If
End Function

and change this:

For Each c In Intersect(Target, rng)

to:

For Each c In Intersect(TargetDependents(Target), rng)

Update in response to comment, the edited code should look like this

Private Function TargetDependents(ByRef Target As Range) As Range
    Dim c As Range

    If Not Target.Dependents Is Nothing Then
        Set TargetDependents = Union(Target, Target.Dependents)
    End If

    If TargetDependents.Cells.Count > Target.Cells.Count Then
        TargetDependents = TargetDependents(TargetDependents)
    End If
End Function

Private Sub Worksheet_Change(ByVal Target As Range)

Dim icol As Integer, c As Range, rng As Range

If Target.Count > 1 Then Exit Sub

Set rng = Range("D2:s1000")

For Each c In Intersect(TargetDependents(Target), rng)

    Select Case UCase(c.Value)
        Case 1: icol = 3
        Case 2: icol = 4
        Case 3: icol = 18
        Case Else: icol = 0
    End Select
    c.Interior.ColorIndex = icol
Next c
End Sub

Upvotes: 1

Related Questions