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

K

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

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
Sort by date Sort by votes
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
Akuini said:
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]
Click to expand...
Akuini, it is working perfect!</SPAN></SPAN>

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

Kind Regards,</SPAN></SPAN>
Kishan :)</SPAN></SPAN>
 
Upvote 0
Rick Rothstein said:
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]
Click to expand...
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
Akuini said:
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]
Click to expand...
Akuini, results are perfect as request! I really appreciate your help in resolving this query as well. </SPAN></SPAN>

Kind Regards,</SPAN></SPAN>
Kishan :biggrin:</SPAN></SPAN>
 
Upvote 0
You're welcome, glad to help, & thanks for the feedback.:)
 
Upvote 0
Kishan said:
Akuini, results are perfect as request! I really appreciate your help in resolving this query as well.
Click to expand...
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
You must log in or register to reply here.

Similar threads

G
  • Question
Formula to count with multiple criteria and exclude from a separate column, then sort by count in one cell with spill
Replies
0
Views
356
Greenbehindthecells
G
V
  • Question
Using UDF on multiple sheets causes #NAME? error
Replies
7
Views
648
VfTom
V
P
  • Solved
Sum by Name, Project and Date (in column)
2 3
Replies
20
Views
1K
Fluff
Fluff
P
  • Question
Can you change the color or formatting of a cell based on the value of a cell on a different page?
Replies
1
Views
506
etaf
etaf
L
  • Question
Dynamic SUM of multiple named tables (structured referencing)
Replies
2
Views
920
leolapa
L

Forum statistics

Threads
1,215,341
Messages
6,124,391
Members
449,155
Latest member
ravioli44

Share this page

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