comma and spécifique numbers coloration

[SBAY3I]

hi forum members
how to color comma and spécifique numbers in excel, for exempl i want to color all numbers under 30 in same column by red.

1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 17, 18, 22, 34, 41, 45, 51, 56, 57, 58, 59, 62, 63, 66, 97, 102, 148 <tbody> </tbody>

15, 16, 26, 39, 42, 60, 74, 77, 78, 94, 101, 103, 105, 116, 140, 144 <tbody> </tbody>

23, 24, 70, 71, 72, 73, 88, 93, 129, 133, 137, 145, 149 <tbody> </tbody>

12, 14, 38, 52, 64, 91, 95, 96, 100, 107, 124 <tbody> </tbody>

<tbody>
</tbody>

 

[MickG]

Assuming each group of numbers are in separate cells in column "A" then try this:-

[COLOR="Navy"]Sub[/COLOR] MG02Sep13
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] St [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] t
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
St = 1
Dn.Value = Dn.Value & ","
[COLOR="Navy"]For[/COLOR] n = 1 To Len(Dn.Value)
    [COLOR="Navy"]If[/COLOR] Mid(Dn.Value, n, 1) = "," [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] St > 0 [COLOR="Navy"]Then[/COLOR]
            txt = Trim(Mid(Dn.Value, St, n - St))
            [COLOR="Navy"]If[/COLOR] Val(txt) < 30 [COLOR="Navy"]Then[/COLOR] Dn.Characters(St, n - St).Font.Color = vbRed
            St = n + 1
        [COLOR="Navy"]End[/COLOR] If
        txt = ""
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] n
Dn.Characters(Len(Dn.Value), 1).Text = ""
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[SBAY3I]

hi all members
thank you very much @MickG its working, i'am realy very thankful for you.
another question if you can help me, also i want to color number 31 to 150 by blue

 

[SBAY3I]

hi @MickG
thank you again with your code i could color also number from 31 to unlimite numbers by blue
Sub MG02Sep13()
Dim Rng As Range, Dn As Range, txt As String, n As Long, St As Long, t
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
For Each Dn In Rng
St = 1
Dn.Value = Dn.Value & ","
For n = 1 To Len(Dn.Value)
If Mid(Dn.Value, n, 1) = "," Then
If St > 0 Then
txt = Trim(Mid(Dn.Value, St, n - St))
If Val(txt) > 30 Then Dn.Characters(St, n - St).Font.Color = vbBlue
St = n + 1
End If
txt = ""
End If
Next n
Dn.Characters(Len(Dn.Value), 1).Text = ""
Next Dn
End Sub

 

[Fluff]

How about

Sub MG02Sep13()
Dim Rng As Range, Dn As Range, txt As String, n As Long, St As Long, t
Set Rng = Range(Range("A1"), Range("A" & Rows.count).End(xlUp))
For Each Dn In Rng
St = 1
Dn.Value = Dn.Value & ","
For n = 1 To Len(Dn.Value)
    If Mid(Dn.Value, n, 1) = "," Then
        If St > 0 Then
            txt = Trim(Mid(Dn.Value, St, n - St))
            Dn.Characters(St, n - St).Font.Color = IIf(val(txt) < 30, vbRed, vbBlue)
            St = n + 1
        End If
        txt = ""
    End If
Next n
Dn.Characters(Len(Dn.Value), 1).Text = ""
Next Dn
End Sub

 

[MickG]

You're welcome

Regards Mick

 

[SBAY3I]

thanks all of you @MickG and @Fluff
last question if i want from 1 to 30 with red and from 31 to 100 with blue and the other number with black what code working for it @MickG and @Fluff

 

[Fluff]

How about

Sub MG02Sep13()
Dim Rng As Range, Dn As Range, txt As String, n As Long, St As Long, t
Dim Clr As String
Set Rng = Range(Range("A1"), Range("A" & Rows.count).End(xlUp))
For Each Dn In Rng
St = 1
Dn.Value = Dn.Value & ","
For n = 1 To Len(Dn.Value)
    If Mid(Dn.Value, n, 1) = "," Then
        If St > 0 Then
            txt = Trim(Mid(Dn.Value, St, n - St))
            Select Case val(txt)
               Case Is <= 30: Clr = vbRed
               Case 31 To 100: Clr = vbBlue
               Case Else: Clr = vbBlack
            End Select
            Dn.Characters(St, n - St).Font.Color = Clr
            St = n + 1
        End If
        txt = ""
    End If
Next n
Dn.Characters(Len(Dn.Value), 1).Text = ""
Next Dn
End Sub

 

[SBAY3I]

thank you very much @Fluff
really i want to learn this stuff, do you have some simple cours

 

[Fluff]

Glad we could help & thanks for the feedback

For courses & info have a look here https://www.mrexcel.com/forum/excel...e-template-excel-spreadsheet.html#post4972842