VBA Code for formatting different parts of Text in Different Colours

[lucksonc5432]

I have created a spreadsheet with one column where I generate a string using the concatenate formula combined with vlookup formula. For example, in cell P2, I have the following formula:

=CONCATENATE(VLOOKUP(J2,Fund_Code,3,0)&", "&VLOOKUP(K2,Strategic_Goal,3,0)&", "&VLOOKUP(L2,Activity_Code,3,0)&", "&VLOOKUP(M2,Delivery_Plan,3,0)&", "&VLOOKUP(N2,Class_Identifier,3,0))

The answer to this becomes:

10_iNotho COE, Fin_Viab, Estab_Civils, Prodt, Necessity

I want assistance with VBA that can format each part of the answer in a separate colour (doesnt matter which colour, they should just be different). The separator should be the comma (,) so that the row appears as follows:

10_iNotho COE, Fin_Viab, Estab_Civils, Prodt, Necessity

The data that needs to appear like that covers the range P2 to P16801

Thanks in advance

 

[6StringJazzer]

You cannot format individual characters when the cell contains a formula. Did you want to convert the formula results to text values first? Or do you need to keep the formulas?

 

[bebo021999]

USe 5 variables for 5 VLOOKUP's
Using VLOOKUP in vba mode, then format the text.
Put this code in module then hit F5 to run once, or creat a button with this code assigned to.
I test with two lookup tables. Adapt it to your actual lookup tables

Option Explicit
Sub Format()
Dim VL1, VL2, VL3, VL4, VL5
Dim cell As Range
Range("P2:P16801").Clear
For Each cell In Range("P2:P16801")
With Application
    VL1 = .IfError(.VLookup(cell.Offset(, -6).Value, Range("A1:B4"), 2, 0), "No match") & ", " ' adjust actual VLOOKUP
    VL2 = .IfError(.VLookup(cell.Offset(, -5).Value, Range("A1:B4"), 2, 0), "No match") & ", " ' adjust actual VLOOKUP
    VL3 = .IfError(.VLookup(cell.Offset(, -4).Value, Range("A1:B4"), 2, 0), "No match") & ", " ' adjust actual VLOOKUP
    VL4 = .IfError(.VLookup(cell.Offset(, -3).Value, Range("A7:B10"), 2, 0), "No match") & ", " ' adjust actual VLOOKUP
    VL5 = .IfError(.VLookup(cell.Offset(, -2).Value, Range("A7:B10"), 2, 0), "No match") ' adjust actual VLOOKUP
End With
    cell = VL1 & VL2 & VL3 & VL4 & VL5 ' read text
    
    With cell
        .Characters(1, Len(VL1)).Font.Color = vbCyan ' read 1st colour
        .Characters(Len(VL1) + 1, Len(VL2)).Font.Color = vbRed ' read 2nd colour
        .Characters(Len(VL1) + Len(VL2) + 1, Len(VL3)).Font.Color = vbBlue ' read 3rd colour
        .Characters(Len(VL1) + Len(VL2) + Len(VL3) + 1, Len(VL4)).Font.Color = vbGreen ' read 4th colour
        .Characters(Len(VL1) + Len(VL2) + Len(VL3) + Len(VL4) + 1, Len(VL5)).Font.Color = vbBlack ' read 5th colour
    End With
Next
End Sub

 

[lucksonc5432]

Option Explicit Sub Format() Dim VL1, VL2, VL3, VL4, VL5 Dim cell As Range Range("P2:P16801").Clear For Each cell In Range("P2:P16801") With Application VL1 = .IfError(.VLookup(cell.Offset(, -6).Value, Range("A1:B4"), 2, 0), "No match") & ", " ' adjust actual VLOOKUP VL2 = .IfError(.VLookup(cell.Offset(, -5).Value, Range("A1:B4"), 2, 0), "No match") & ", " ' adjust actual VLOOKUP VL3 = .IfError(.VLookup(cell.Offset(, -4).Value, Range("A1:B4"), 2, 0), "No match") & ", " ' adjust actual VLOOKUP VL4 = .IfError(.VLookup(cell.Offset(, -3).Value, Range("A7:B10"), 2, 0), "No match") & ", " ' adjust actual VLOOKUP VL5 = .IfError(.VLookup(cell.Offset(, -2).Value, Range("A7:B10"), 2, 0), "No match") ' adjust actual VLOOKUP End With cell = VL1 & VL2 & VL3 & VL4 & VL5 ' read text With cell .Characters(1, Len(VL1)).Font.Color = vbCyan ' read 1st colour .Characters(Len(VL1) + 1, Len(VL2)).Font.Color = vbRed ' read 2nd colour .Characters(Len(VL1) + Len(VL2) + 1, Len(VL3)).Font.Color = vbBlue ' read 3rd colour .Characters(Len(VL1) + Len(VL2) + Len(VL3) + 1, Len(VL4)).Font.Color = vbGreen ' read 4th colour .Characters(Len(VL1) + Len(VL2) + Len(VL3) + Len(VL4) + 1, Len(VL5)).Font.Color = vbBlack ' read 5th colour End With Next End Sub

Thanks, will try this and give feedbacj

 

[lucksonc5432]

USe 5 variables for 5 VLOOKUP's
Using VLOOKUP in vba mode, then format the text.
Put this code in module then hit F5 to run once, or creat a button with this code assigned to.
I test with two lookup tables. Adapt it to your actual lookup tables

Option Explicit
Sub Format()
Dim VL1, VL2, VL3, VL4, VL5
Dim cell As Range
Range("P2:P16801").Clear
For Each cell In Range("P2:P16801")
With Application
    VL1 = .IfError(.VLookup(cell.Offset(, -6).Value, Range("A1:B4"), 2, 0), "No match") & ", " ' adjust actual VLOOKUP
    VL2 = .IfError(.VLookup(cell.Offset(, -5).Value, Range("A1:B4"), 2, 0), "No match") & ", " ' adjust actual VLOOKUP
    VL3 = .IfError(.VLookup(cell.Offset(, -4).Value, Range("A1:B4"), 2, 0), "No match") & ", " ' adjust actual VLOOKUP
    VL4 = .IfError(.VLookup(cell.Offset(, -3).Value, Range("A7:B10"), 2, 0), "No match") & ", " ' adjust actual VLOOKUP
    VL5 = .IfError(.VLookup(cell.Offset(, -2).Value, Range("A7:B10"), 2, 0), "No match") ' adjust actual VLOOKUP
End With
    cell = VL1 & VL2 & VL3 & VL4 & VL5 ' read text
   
    With cell
        .Characters(1, Len(VL1)).Font.Color = vbCyan ' read 1st colour
        .Characters(Len(VL1) + 1, Len(VL2)).Font.Color = vbRed ' read 2nd colour
        .Characters(Len(VL1) + Len(VL2) + 1, Len(VL3)).Font.Color = vbBlue ' read 3rd colour
        .Characters(Len(VL1) + Len(VL2) + Len(VL3) + 1, Len(VL4)).Font.Color = vbGreen ' read 4th colour
        .Characters(Len(VL1) + Len(VL2) + Len(VL3) + Len(VL4) + 1, Len(VL5)).Font.Color = vbBlack ' read 5th colour
    End With
Next
End Sub

View attachment 53868

Tried it, Works like a charm!!!! Thanks so much!!