Adding Color to figures within the result of a formula 1

[LGMan]

Hi carrying on from a thread that I started on the Microsoft Office forum hoping CFs might help.

I have a formula that pulls data from a table such as a Team Name and a result figure in order of high to low results, I would like to colour code the result figure so that results greater than or equal to 95% are green and results less than 95% are red.
here is my formula in cell F6

=VLOOKUP(1,A610,2,0)&" ("&TEXT(VLOOKUP(1,A610,4,0),"0.00")&"%), "&VLOOKUP(2,A610,2,0)&" ("&TEXT(VLOOKUP(2,A610,4,0),"0.00")&"%), "&VLOOKUP(3,A610,2,0)&" ("&TEXT(VLOOKUP(3,A610,4,0),"0.00")&"%), "&VLOOKUP(4,A610,2,0)&" ("&TEXT(VLOOKUP(4,A610,4,0),"0.00")&"%) & "&VLOOKUP(5,A610,2,0)&" ("&TEXT(VLOOKUP(5,A610,4,0),"0.00")&"%) "
So the result looks like this

North ([green]96.00%[/green]), South ([green]95.00%[/green]), West ([red]94.00%[/red]), North ([red]93.00%[/red]) & Central ([red]92.00%[/red])

The table consists of Team Names in B6:B10 and Results in D610. A6:A10 contains a Rank high to low, from 1 to 5.

Is there a way to add the color coding via VBA. If it's not possible to apply colors to the formula in F6, then I could easily copy and paste as values into G6, if applying color is more straight forward to a text string.

Thanks

 

[SkipVought]

Hi,

Given a cell with a STRING, not a formula, containing data like...
[tt]
North (96.00%), South (95.00%), West (94.00%), North (93.00%) & Central (92.00%)
[/tt]
then selecting the cell containing this data and running this procedure will shade the font as requested...

Sub SpecialCF()
[b]'this works on the data in the ActiveCell[/b]
    Dim i As Integer, iFR As Integer, iTH As Integer, iLN As Integer
    
    With ActiveCell
        Do
            iFR = InStr(iTH + 1, .Value, "(")
            If iFR = 0 Then Exit Do
            iTH = InStr(iFR + 1, .Value, ")")
            iLN = iTH - iFR + 1
            
            Select Case (Mid(.Value, iFR + 1, iLN - 2)) * 1
                Case Is >= 95
                    With .Characters(Start:=iFR, Length:=iLN).Font
                        .Color = -11489280
                    End With
                Case Else
                    With .Characters(Start:=iFR, Length:=iLN).Font
                        .Color = -16776961
                    End With
            End Select
            
        Loop
    End With
End Sub

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[strongm]

>if applying color is more straight forward to a text string.

Yep, as Skip has been trying to tell you.

 

[LGMan]

Hi Skip, thanks for the code, I've copied the data from the Vlookup and used the PasteSpecial Paste:=xlPasteValues method, however I get a Run Time error '13' Type Mismatch
on
Select Case (Mid(.Value, iFR + 1, iLN - 2)) * 1
I'm using Excel 2013

 

[SkipVought]

So you did a PasteSpecial xlPasteValues into a cell.

Is that cell the ActiveCell when you ran the procedure?

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[LGMan]

Hi Skip, yes, added H1 copy, H3 pastespecial, and H3 is the active cell. But code still errors on
Select Case (Mid(.Value, iFR + 1, iLN - 2)) * 1

Sub SpecialCF()
'this works on the data in the ActiveCell
    Dim i As Integer, iFR As Integer, iTH As Integer, iLN As Integer
    Range("H1").Copy
    Range("H3").PasteSpecial Paste:=xlPasteValues
    With ActiveCell
        Do
            iFR = InStr(iTH + 1, .Value, "(")
            If iFR = 0 Then Exit Do
            iTH = InStr(iFR + 1, .Value, ")")
            iLN = iTH - iFR + 1
            
            Select Case (Mid(.Value, iFR + 1, iLN - 2)) * 1
                Case Is >= 95
                    With .Characters(Start:=iFR, Length:=iLN).Font
                        .Color = -11489280
                    End With
                Case Else
                    With .Characters(Start:=iFR, Length:=iLN).Font
                        .Color = -16776961
                    End With
            End Select
            
        Loop
    End With
End Sub

 

[SkipVought]

Sub SpecialCF()
    Dim i As Integer, iFR As Integer, iTH As Integer, iLN As Integer
    
    Range("H1").Copy
    
    With Range("H3")
        .PasteSpecial Paste:=xlPasteValues
        Do
            iFR = InStr(iTH + 1, .Value, "(")
            If iFR = 0 Then Exit Do
            iTH = InStr(iFR + 1, .Value, ")")
            iLN = iTH - iFR + 1
            
            Select Case (Mid(.Value, iFR + 1, iLN - 3)) * 1
                Case Is >= 95
                    With .Characters(Start:=iFR, Length:=iLN).Font
                        .Color = -11489280
                    End With
                Case Else
                    With .Characters(Start:=iFR, Length:=iLN).Font
                        .Color = -16776961
                    End With
            End Select
            
        Loop
    End With
End Sub

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[LGMan]

Skip, Many thanks