VBA: Specific number in a serie-of-numbers in a cell equals a color

Infine

New Member
Joined
Oct 16, 2019
Messages
16
Hello,

If I have numbers in a cell "1294392393", I want the 4th from the right side (the thousand number), I want a "color/border" on the whole columns.

For instance:

"1294392393" = 12943[9]393 ----- the nr "9" shall make a color blue on the whole column.
In a row below the "12943" = 1[2]943 ----- The nr "2" shall make a color orange on the whole column.

"1000" = [1]000 ---- The nr "1" shall have the color Red on the whole column.

And last example:

"14751565152512" = 1475156515[2]512 ---- the nr 2 shall have orange on the whole column.



I found this code in this forum from someone else topic:

Code:
Sub Controll_datas()
On Error Resume Next

Dim c As Range

For Each c In Range("C2", Range("C" & Rows.Count).End(xlUp))
    If IsNumeric(Mid(c, 3, 1)) Then
        c = "TGMS"
    End If
Next c

End Sub
This takes ANY number, I want specific number, and instead of c= "TGMS" I want to make for each nr a color.
So every number:
1 = blue
2 = orange
3 = etc etc. until 9.


How should I code this? I can't figure out because I want specific number, not any... I want to If IsNumeric(Right(c, 4, 1) = 1) Then for nr 1. but this doesn't work...
I know coding on PHP, so excel coding is a bit different where I need to relearn some.
 

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
16,645
I'm not clear on what you mean by a "number shall have a certain color on the whole column". Can you post a sample of the data and what it should look like after the code is executed?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
30,378
Office Version
365
Platform
Windows
Not quite sure what you mean by colour the entire column, so this will add background fill to each cell
Code:
Sub Infine()
    Dim Cl As Range

    For Each Cl In Range("C2", Range("C" & Rows.Count).End(xlUp))
        Cl.Interior.ColorIndex = Choose(Left(Right(Cl, 4), 1)+1, [COLOR=#ff0000]3, 5, 9, 11, 15, 23, 35, 44, 56, 49[/COLOR])
    Next Cl
End Sub
Change the numbers in red to match the colour you want.
 

Infine

New Member
Joined
Oct 16, 2019
Messages
16



Like this image is what I mean, but maybe instead just color "A-D" and then I can change the range in the future if I see the code.
 

Infine

New Member
Joined
Oct 16, 2019
Messages
16
Fluff your code didn't work. I get error message.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
30,378
Office Version
365
Platform
Windows
To colour columns A:D use
Code:
Sub Infine()
    Dim Cl As Range

    For Each Cl In Range("C2", Range("C" & Rows.Count).End(xlUp))
        Intersect(Cl.EntireRow, Range("A:D")).Interior.ColorIndex = Choose(Left(Right(Cl, 4), 1)+1, 3, 5, 9, 11, 15, 23, 35, 44, 56, 49)
    Next Cl
End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
30,378
Office Version
365
Platform
Windows
Fluff your code didn't work. I get error message.
What was the error number & message?
Also when you click debug, what line was highlighted?
 

Infine

New Member
Joined
Oct 16, 2019
Messages
16
Run time error "13"
Type missmatch

Code:
For Each Cl In Range("C2", Range("C" & Rows.Count).End(xlUp))
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
30,378
Office Version
365
Platform
Windows
Not sure how you get that error on that line, but are your numbers in col C?
 

Infine

New Member
Joined
Oct 16, 2019
Messages
16
Yes sir, on C. I debuged it again and now it is on:

Code:
Intersect(Cl.EntireRow, Range("A:D")).Interior.ColorIndex = Choose(Left(Right(Cl, 4), 1) + 1, 3, 5, 9, 11, 15, 23, 35, 44, 56, 49)
 

Forum statistics

Threads
1,078,134
Messages
5,338,430
Members
399,232
Latest member
stevenmoritz

Some videos you may like

This Week's Hot Topics

Top