How to change color based on formula result?

0
votes

I made a macro, that changes the color of specific characters in a range of cells.

The macro works if the cell content is written manually.

I want the macro to read the formula result in the range instead, because the cells will have different combinations of x, y and 7 according to a user defined function (a bunch of if-statements).

The macro is showing wrong colors, when the cell content is not manually written.

I tried a time delay for my macro, so it would execute after my user defined function, because I thought my macro maybe executed before. That didn't work. That's why I think the problem is that the macro doesn't read the formula result.

Public Sub ChangeColor()
    Dim MyRange As Range
    Dim FarveZ As Integer
    Dim FarveX As Integer
    Dim Farve7 As Integer

    Set MyRange = Range("G32:R34")  

    FarveZ = 26   
    FarveX = 46   
    Farve7 = 3   

    For Each tempstring In MyRange
        If tempstring = "zx7" Then
            tempstring.Characters(Start:=1, Length:=1).Font.ColorIndex = FarveZ
            tempstring.Characters(Start:=2, Length:=1).Font.ColorIndex = FarveX
            tempstring.Characters(Start:=3, Length:=1).Font.ColorIndex = Farve7
        ElseIf tempstring = "zx" Then
            tempstring.Characters(Start:=1, Length:=1).Font.ColorIndex = FarveZ
            tempstring.Characters(Start:=2, Length:=1).Font.ColorIndex = FarveX
        ElseIf tempstring = "z7" Then
            tempstring.Characters(Start:=1, Length:=1).Font.ColorIndex = FarveZ
            tempstring.Characters(Start:=2, Length:=1).Font.ColorIndex = Farve7
        ElseIf tempstring = "x7" Then
            tempstring.Characters(Start:=1, Length:=1).Font.ColorIndex = FarveX
            tempstring.Characters(Start:=2, Length:=1).Font.ColorIndex = Farve7
        ElseIf tempstring = "z" Then
            tempstring.Characters(Start:=1, Length:=1).Font.ColorIndex = FarveZ
        ElseIf tempstring = "x" Then
            tempstring.Characters(Start:=1, Length:=1).Font.ColorIndex = FarveX
        ElseIf tempstring = "7" Then
            tempstring.Characters(Start:=1, Length:=1).Font.ColorIndex = Farve7
        Else
            Exit Sub
        End If
    Next tempstring

End Sub

I don't get any error messages. It just doesn't come up with the right colors.

1
excelvba
Since tempstring is not a string, but a range, the name is quite misleading IMO. BTW tempstring doesn't seem declared, is it somewhere else in the code? - Vincent G
Hello, not it's actually not declared. I'm a newbie when it comes to VBA. I tried to declare it as a string, but it didnt work. Should I declare it as a range? - Christina
Yes, it is not a string, either a variant or a range. You might want to replace all of your If... Then ... End If block by a Select Case structure, it will probably be more readable. And use tempstring.Value2 to evaluate the value. - Vincent G
Also, another great tool when you are beginning with VBA is to use Option Explicit at the start of any module. This will force you to declare all variables. - Zack E
The issue you're having is that while the value of the cell is being tested correctly, you are colouring individual cell characters - You can't apply colour manually to part of a formula - so a macro is also unlikely to be able to do this. - CLR

1 Answers

0
votes

As per my comments, the following routine, tweaked and adjusted from your own - will create a copy of your formula results, 10 rows below that is colour coded as per your code.

You can even hide the rows 32-34 if you like, the coding can still 'see' the values and will still work fine.

Public Sub ChangeColor()
    Dim MyRange As Range
    Dim FarveZ As Integer
    Dim FarveX As Integer
    Dim Farve7 As Integer
    Dim Rowoffset As Long

    Set MyRange = Range("G32:R34")

    Rowoffset = 10 ' change this value to move the copy

    FarveZ = 26
    FarveX = 46
    Farve7 = 3

    For Each FormulaArea In MyRange
        Set OffsetData = FormulaArea.Offset(Rowoffset, 0)
        OffsetData.Value = FormulaArea.Value
        Select Case FormulaArea.Value
            Case "zx7"
                OffsetData.Characters(Start:=1, Length:=1).Font.ColorIndex = FarveZ
                OffsetData.Characters(Start:=2, Length:=1).Font.ColorIndex = FarveX
                OffsetData.Characters(Start:=3, Length:=1).Font.ColorIndex = Farve7
            Case "zx"
                OffsetData.Characters(Start:=1, Length:=1).Font.ColorIndex = FarveZ
                OffsetData.Characters(Start:=2, Length:=1).Font.ColorIndex = FarveX
            Case "z7"
                OffsetData.Characters(Start:=1, Length:=1).Font.ColorIndex = FarveZ
                OffsetData.Characters(Start:=2, Length:=1).Font.ColorIndex = Farve7
            Case "x7"
                OffsetData.Characters(Start:=1, Length:=1).Font.ColorIndex = FarveX
                OffsetData.Characters(Start:=2, Length:=1).Font.ColorIndex = Farve7
            Case "z"
                OffsetData.Characters(Start:=1, Length:=1).Font.ColorIndex = FarveZ
            Case "x"
                OffsetData.Characters(Start:=1, Length:=1).Font.ColorIndex = FarveX
            Case "7"
                OffsetData.Characters(Start:=1, Length:=1).Font.ColorIndex = Farve7
        End Select
    Next FormulaArea

End Sub

A slightly tidier way to do this would be testing based on just each character:

Public Sub ChangeColor_version2()
    Dim MyRange As Range
    Dim FarveZ As Integer
    Dim FarveX As Integer
    Dim Farve7 As Integer
    Dim Rowoffset As Long
    Dim x as Long

    Set MyRange = Range("G32:R34")
    'For multiple tabs, specify the sheet that contains the formulas:
    'Set MyRange = Sheets("existing_sheet_name").Range("G32:R34")

    Rowoffset = 10 ' change this value to move the copy

    FarveZ = 26
    FarveX = 46
    Farve7 = 3

    For Each FormulaArea In MyRange
        Set OffsetData = FormulaArea.Offset(Rowoffset, 0)

        ' For multiple tabs, specify the destination sheet in the setting of the OffsetData range like this:
        ' Set OffsetData = Sheets("other_sheet_name").Range("A1").Offset(Rowoffset + FormulaArea.Row, FormulaArea.Column)

        OffsetData.Value = "'" & FormulaArea.Value
        For x = 1 To Len(FormulaArea.Value)
            With OffsetData.Characters(Start:=x, Length:=1)
            Select Case .Text
                Case "z"
                    .Font.ColorIndex = FarveZ
                Case "x"
                    .Font.ColorIndex = FarveX
                Case "7"
                    .Font.ColorIndex = Farve7
            End Select
            End With
        Next
    Next FormulaArea

End Sub