VBA, which can colour A, B, C, D and E separated by vertical bar

Kishan

Well-known Member
Joined
Mar 15, 2011
Messages
1,648
Office Version
  1. 2010
Platform
  1. Windows
Using Excel 2000</SPAN></SPAN>

I got data in the column C (A, B, C, D and E) separated by vertical bar and there is a one space between vertical bar also that I want to coloured all different colour but each alphabet must be the same colour in the below example there are coloured only row 5 & 6 but I need to coloured as long as data are find in the column C
</SPAN></SPAN>


Book1
ABCDE
1
2
3
4P1
5[/COLOR][COLOR=#0000cd]B[/COLOR][COLOR=#000000] | [/COLOR][COLOR=#006400]C [/COLOR][COLOR=#000000]| [/COLOR][COLOR=#800000]D[/COLOR][COLOR=#000000] | [/COLOR][COLOR=#800000]D[/COLOR][COLOR=#000000] | [/COLOR][COLOR=#4b0082]E[/COLOR][/B][COLOR=#000000]
6[/COLOR][COLOR=#ff0000]A[/COLOR][/B][COLOR=#000000] | [/COLOR][COLOR=#0000cd]B[/COLOR][COLOR=#000000] | [/COLOR][COLOR=#800000]D[/COLOR][COLOR=#000000] | [/COLOR][COLOR=#4b0082]E[/COLOR][COLOR=#000000] | [/COLOR][COLOR=#4b0082]E[/COLOR][COLOR=#000000]
7B | B | B | D | D
8A | A | D | D | D
9B | C | C | E | E
10D | D | D | E | E
11A | A | A | C | E
12A | B | C | C | D
13A | A | A | B | C
14B | B | C | D | D
15A | A | C | E | E
16A | A | B | C | C
17B | B | C | D | D
18A | A | C | D | D
19B | C | D | D | E
20A | B | D | E | E
21A | B | D | E | E
22A | A | A | A | E
23A | C | C | D | E
24A | C | C | D | D
25A | C | C | C | D
26A | A | B | B | E
27C | C | D | D | E
28A | A | C | D | D
29A | A | B | D | E
30A | B | C | D | E
31B | C | E | E | E
32A | A | A | C | D
33A | B | C | C | E
34A | B | B | B | D
35A | C | D | D | D
36B | B | C | D | E
37C | C | C | E | E
38B | B | C | E | E
39A | A | B | B | E
40B | C | C | D | E
41A | A | C | C | D
42
43
44
45
46
Sheet16


Thank you in advance
</SPAN></SPAN>

Regards
</SPAN></SPAN>,</SPAN>
Kishan
</SPAN></SPAN>
 
Last edited:

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Try this:

Code:
[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1086306a()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1086306-vba-can-colour-b-c-d-e-separated-vertical-bar.html[/COLOR][/I]
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], j [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] va
[COLOR=Royalblue]Dim[/COLOR] d [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Object[/COLOR]

Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]
[COLOR=Royalblue]Set[/COLOR] d = CreateObject([COLOR=brown]"scripting.dictionary"[/COLOR])
    d([COLOR=brown]"A"[/COLOR]) = [COLOR=crimson]5287936[/COLOR] [I][COLOR=seagreen]'green[/COLOR][/I]
    d([COLOR=brown]"B"[/COLOR]) = vbBlue
    d([COLOR=brown]"C"[/COLOR]) = vbRed
    d([COLOR=brown]"D"[/COLOR]) = [COLOR=crimson]13209[/COLOR] [I][COLOR=seagreen]'brown[/COLOR][/I]
    d([COLOR=brown]"E"[/COLOR]) = vbMagenta

va = Range([COLOR=brown]"C1"[/COLOR], Cells(Rows.count, [COLOR=brown]"C"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp))

[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]5[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])
    [COLOR=Royalblue]For[/COLOR] j = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]17[/COLOR] [COLOR=Royalblue]Step[/COLOR] [COLOR=crimson]4[/COLOR]
    Cells(i, [COLOR=brown]"C"[/COLOR]).Characters(j, [COLOR=crimson]1[/COLOR]).Font.Color = d([COLOR=Royalblue]Mid[/COLOR](va(i, [COLOR=crimson]1[/COLOR]), j, [COLOR=crimson]1[/COLOR]))
    [COLOR=Royalblue]Next[/COLOR]
[COLOR=Royalblue]Next[/COLOR]

Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]
 
Last edited:
Upvote 0
Here is another macro that you can try (it assumes the colors I get when I copy from your message into Excel are the same as on your actual worksheet... change the color codes I specified if not)...
Code:
[table="width: 500"]
[tr]
	[td]Sub ColorLetters()
  Dim R As Long, C As Long, Colors As Variant
  [B][COLOR="#008000"]' Numbers are the font colors for the letters A,B,C,D and E in that order[/COLOR][/B]
  Colors = Array(255, 13434880, 25600, 128, 8519755)
  For R = 5 To Cells(Rows.Count, "C").End(xlUp).Row
    For C = 1 To 17 Step 4
      Cells(R, "C").Characters(C, 1).Font.Color = Colors(Asc(Cells(R, "C").Characters(C, 1).Text) - 65)
    Next
  Next
End Sub[/td]
[/tr]
[/table]
 
Last edited:
Upvote 0
Try this:

Code:
[FONT=lucida console][COLOR=royalblue]Sub[/COLOR] a1086306a()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1086306-vba-can-colour-b-c-d-e-separated-vertical-bar.html[/COLOR][/I]
[COLOR=royalblue]End[/COLOR] [COLOR=royalblue]Sub[/COLOR][/FONT]
Akuini, it is working perfect!</SPAN></SPAN>

Thank you for your help
</SPAN></SPAN>

Kind Regards,
</SPAN></SPAN>
Kishan :)
</SPAN></SPAN>
 
Upvote 0
Here is another macro that you can try (it assumes the colors I get when I copy from your message into Excel are the same as on your actual worksheet... change the color codes I specified if not)...
Code:
[TABLE="width: 500"]
<TBODY>[TR]
[TD]Sub ColorLetters()
  Dim R As Long, C As Long, Colors As Variant
 End Sub
[/TD]
[/TR]
</TBODY>[/TABLE]
Rick Rothstein, it is working perfect! And found the colours are set as per #post1.</SPAN></SPAN>

Thank you for your help
</SPAN></SPAN>

Kind Regards,
</SPAN></SPAN>
Kishan :)
</SPAN></SPAN>
 
Upvote 0
Hi, will it be possible that get modified VBA solution having a situation using a numbers instead of alphabets as shown in the example below </SPAN></SPAN>


Book1
ABCDE
1
2
3
4P1
5[/COLOR][COLOR=#ff0000]02[/COLOR][COLOR=#000000] | [/COLOR][COLOR=#0000ff]03[/COLOR][COLOR=#000000] | [/COLOR][COLOR=#0000ff]03[/COLOR][COLOR=#000000] | [/COLOR][COLOR=#006400]04[/COLOR][COLOR=#000000] | [/COLOR][COLOR=#ee82ee]05[/COLOR][COLOR=#000000]
6[/COLOR][COLOR=#0000ff]03[/COLOR][COLOR=#000000] | [/COLOR][COLOR=#006400]04[/COLOR][/B][COLOR=#000000] | [/COLOR][COLOR=#006400]04[/COLOR][/B][COLOR=#000000] | [/COLOR][COLOR=#006400]04[/COLOR][COLOR=#000000] | [/COLOR][COLOR=#ee82ee]05[/COLOR][COLOR=#000000]
701 | 02 | 02 | 03 | 03
803 | 03 | 04 | 04 | 04
901 | 01 | 01 | 02 | 02
1001 | 01 | 02 | 05 | 05
1101 | 03 | 05 | 05 | 05
1201 | 01 | 02 | 04 | 05
1303 | 03 | 03 | 04 | 05
1402 | 03 | 04 | 05 | 05
1501 | 01 | 01 | 01 | 02
1603 | 03 | 03 | 03 | 05
1701 | 01 | 04 | 04 | 04
1801 | 02 | 03 | 04 | 05
1902 | 03 | 03 | 05 | 05
2002 | 03 | 03 | 03 | 05
2101 | 02 | 02 | 02 | 02
2201 | 05 | 05 | 05 | 05
2301 | 01 | 02 | 04 | 05
2403 | 03 | 03 | 04 | 05
2502 | 03 | 04 | 05 | 05
2601 | 01 | 01 | 01 | 02
2703 | 03 | 03 | 03 | 05
2801 | 01 | 04 | 04 | 04
2901 | 02 | 03 | 04 | 05
3002 | 03 | 03 | 05 | 05
3102 | 03 | 03 | 03 | 05
3203 | 04 | 04 | 04 | 05
3301 | 02 | 02 | 03 | 03
3403 | 03 | 04 | 04 | 04
3501 | 01 | 01 | 02 | 02
3601 | 01 | 02 | 05 | 05
3701 | 02 | 03 | 04 | 05
3802 | 03 | 03 | 05 | 05
3902 | 03 | 03 | 03 | 05
4001 | 02 | 02 | 02 | 02
4101 | 05 | 05 | 05 | 05
42
43
44
45
46
Sheet17


Thank you in advance
</SPAN></SPAN>

Kind Regards,
</SPAN></SPAN>
Kishan
</SPAN></SPAN>
 
Upvote 0
Try this:

Code:
[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1086306b()                                                                                                                      
 [I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1086306-vba-can-colour-b-c-d-e-separated-vertical-bar.html[/COLOR][/I]                                                 
 [COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], j [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]                                    
 [COLOR=Royalblue]Dim[/COLOR] va                                                                                                                                                          
 [COLOR=Royalblue]Dim[/COLOR] d [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Object[/COLOR]                                                                                               
                                                                                                                                                                                         
 Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]                                                                                                                              
 [COLOR=Royalblue]Set[/COLOR] d = CreateObject([COLOR=brown]"scripting.dictionary"[/COLOR])                                                                                               
    d([COLOR=Royalblue]CStr[/COLOR]([COLOR=brown]"01"[/COLOR])) = [COLOR=crimson]5287936[/COLOR] [I][COLOR=seagreen]'green[/COLOR][/I]                                                    
    d([COLOR=Royalblue]CStr[/COLOR]([COLOR=brown]"02"[/COLOR])) = vbBlue                                                                                                                  
    d([COLOR=Royalblue]CStr[/COLOR]([COLOR=brown]"03"[/COLOR])) = vbRed                                                                                                                   
    d([COLOR=Royalblue]CStr[/COLOR]([COLOR=brown]"04"[/COLOR])) = [COLOR=crimson]13209[/COLOR] [I][COLOR=seagreen]'brown[/COLOR][/I]                                                      
    d([COLOR=Royalblue]CStr[/COLOR]([COLOR=brown]"05"[/COLOR])) = vbMagenta                                                                                                               
                                                                                                                                                                                         
 va = Range([COLOR=brown]"C1"[/COLOR], Cells(Rows.count, [COLOR=brown]"C"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp))                                                                    
                                                                                                                                                                                         
 [COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]5[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])                                                               
     [COLOR=Royalblue]For[/COLOR] j = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]22[/COLOR] [COLOR=Royalblue]Step[/COLOR] [COLOR=crimson]5[/COLOR]               
     Cells(i, [COLOR=brown]"C"[/COLOR]).Characters(j, [COLOR=crimson]2[/COLOR]).Font.Color = d([COLOR=Royalblue]Mid[/COLOR](va(i, [COLOR=crimson]1[/COLOR]), j, [COLOR=crimson]2[/COLOR]))
     [COLOR=Royalblue]Next[/COLOR]                                                                                                                                                        
 [COLOR=Royalblue]Next[/COLOR]                                                                                                                                                            
                                                                                                                                                                                         
 Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]                                                                                                                               
 [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR]                                                                                                                                
 [/FONT]
 
Upvote 0
Try this:

Code:
[FONT=lucida console][COLOR=royalblue]Sub[/COLOR] a1086306b()                                                                                                                      
 [I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1086306-vba-can-colour-b-c-d-e-separated-vertical-bar.html[/COLOR][/I]                                                 
 [COLOR=royalblue]Dim[/COLOR] i [COLOR=royalblue]As[/COLOR] [COLOR=royalblue]Long[/COLOR], j [COLOR=royalblue]As[/COLOR] [COLOR=royalblue]Long[/COLOR]                                    
 [COLOR=royalblue]Dim[/COLOR] va                                                                                                                                                          
 [COLOR=royalblue]Dim[/COLOR] d [COLOR=royalblue]As[/COLOR] [COLOR=royalblue]Object[/COLOR]                                                                                               
                                                                                                                                                                                         
 Application.ScreenUpdating = [COLOR=royalblue]False[/COLOR]                                                                                                                              
 [COLOR=royalblue]Set[/COLOR] d = CreateObject([COLOR=brown]"scripting.dictionary"[/COLOR])                                                                                               
    d([COLOR=royalblue]CStr[/COLOR]([COLOR=brown]"01"[/COLOR])) = [COLOR=crimson]5287936[/COLOR] [I][COLOR=seagreen]'green[/COLOR][/I]                                                    
    d([COLOR=royalblue]CStr[/COLOR]([COLOR=brown]"02"[/COLOR])) = vbBlue                                                                                                                  
    d([COLOR=royalblue]CStr[/COLOR]([COLOR=brown]"03"[/COLOR])) = vbRed                                                                                                                   
    d([COLOR=royalblue]CStr[/COLOR]([COLOR=brown]"04"[/COLOR])) = [COLOR=crimson]13209[/COLOR] [I][COLOR=seagreen]'brown[/COLOR][/I]                                                      
    d([COLOR=royalblue]CStr[/COLOR]([COLOR=brown]"05"[/COLOR])) = vbMagenta                                                                                                               
                                                                                                                                                                                         
 va = Range([COLOR=brown]"C1"[/COLOR], Cells(Rows.count, [COLOR=brown]"C"[/COLOR]).[COLOR=royalblue]End[/COLOR](xlUp))                                                                    
                                                                                                                                                                                         
 [COLOR=royalblue]For[/COLOR] i = [COLOR=crimson]5[/COLOR] [COLOR=royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])                                                               
     [COLOR=royalblue]For[/COLOR] j = [COLOR=crimson]1[/COLOR] [COLOR=royalblue]To[/COLOR] [COLOR=crimson]22[/COLOR] [COLOR=royalblue]Step[/COLOR] [COLOR=crimson]5[/COLOR]               
     Cells(i, [COLOR=brown]"C"[/COLOR]).Characters(j, [COLOR=crimson]2[/COLOR]).Font.Color = d([COLOR=royalblue]Mid[/COLOR](va(i, [COLOR=crimson]1[/COLOR]), j, [COLOR=crimson]2[/COLOR]))
     [COLOR=royalblue]Next[/COLOR]                                                                                                                                                        
 [COLOR=royalblue]Next[/COLOR]                                                                                                                                                            
                                                                                                                                                                                         
 Application.ScreenUpdating = [COLOR=royalblue]True[/COLOR]                                                                                                                               
 [COLOR=royalblue]End[/COLOR] [COLOR=royalblue]Sub[/COLOR]                                                                                                                                
 [/FONT]
Akuini, results are perfect as request! I really appreciate your help in resolving this query as well. </SPAN></SPAN>

Kind Regards,
</SPAN></SPAN>
Kishan :-D
</SPAN></SPAN>
 
Upvote 0
You're welcome, glad to help, & thanks for the feedback.:)
 
Upvote 0
Akuini, results are perfect as request! I really appreciate your help in resolving this query as well.
If you are interested, here is my code modified for your formatted 2-digit numbers...
Code:
[table="width: 500"]
[tr]
	[td]Sub ColorLetters()
  Dim R As Long, C As Long, Colors As Variant
  ' Numbers are the font colors for the numbers 01, 02, 03, 04 and 05 in that order
  Colors = Array(255, 13434880, 25600, 128, 8519755)
  For R = 5 To Cells(Rows.Count, "C").End(xlUp).Row
    For C = 1 To 22 Step 5
      Cells(R, "C").Characters(C, 2).Font.Color = Colors(Cells(R, "C").Characters(C, 2).Text - 1)
    Next
  Next
End Sub[/td]
[/tr]
[/table]
 
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,287
Members
452,631
Latest member
a_potato

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top