Font color Number

[cotech_10]

I have a simple column setup in which in each individual cell will contain a paired number with a semicolon separator as per below:

202;105
120;117
4;500
39;195
32;66
41;889
8;26
212;135
108;200

What I would like to achieve is to change the font color say to the color RED of an individual number in a paired group according to a specific criteria

For example the number criteria's for font color change could be as follows: 202, 4, 889, 108 & 66

So the end result would result in the numbers 202, 4, 889, 108 and 32 colored in Red and its paired counterpart would be default black.

202;105
120;117
4;500
39;195
32;66
41;889
8;26
212;135
108;200






Thanks and Regards

 

[Peter_SSs]

Assuming data in column A starting in row 2, see if this does what you want.

Sub Colour_Font()
  Dim a As Variant, Nums As Variant
  Dim i As Long, j As Long, pos As Long
  Dim s As String
  
  Const myNums As String = "202 4 889 108 66"
  
  Nums = Split(";" & Join(Split(myNums), "; ;") & ";")
  With Range("A2", Range("A" & Rows.Count).End(xlUp))
    a = .Value
    For i = 1 To UBound(a)
      s = ";" & a(i, 1) & ";"
      For j = 0 To UBound(Nums)
        pos = InStr(1, s, Nums(j))
        If pos > 0 Then .Cells(i, 1).Characters(pos, Len(Nums(j)) - 2).Font.Color = vbRed
      Next j
    Next i
  End With
End Sub

 

[cotech_10]

Sub Colour_Font() Dim a As Variant, Nums As Variant Dim i As Long, j As Long, pos As Long Dim s As String Const myNums As String = "202 4 889 108 66" Nums = Split(";" & Join(Split(myNums), "; ;") & ";") With Range("A2", Range("A" & Rows.Count).End(xlUp)) a = .Value For i = 1 To UBound(a) s = ";" & a(i, 1) & ";" For j = 0 To UBound(Nums) pos = InStr(1, s, Nums(j)) If pos > 0 Then .Cells(i, 1).Characters(pos, Len(Nums(j)) - 2).Font.Color = vbRed Next j Next i End With End Sub

Hi Peter,

Firstly thank you for your response, greatly appreciated.

What I was looking to achieve is the string of numbers for the ciriteria can be made up of any string of numbers not a fixed number set as noted in my previous post


For example I could have the following paired numbers starting in cell A2

9;106
130;137
4;50
29;295
3;6
1;8
8;26
242;335
208;204
3;5
16;100
2;90
3;8
44;66
etc

The string of numbers could start in say cell A1 and they could be as follows:

9, 4, 8, 208, 44, 242, 6 etc

Therefore the font colored numbers would be as follows :

9;106
130;137
4;50
29;295
3;6
1;8
8;26
242;335
208;204
3;5
16;100
2;90
3;8
44;66


or the numbers could be

106, 77, 88, 109, 2, 400, 500, 199 etc


And the font colored numbers would then be :

9;106
130;137
4;50
29;295
3;6
1;8
8;26
242;335
208;204
3;5
16;100
2;90
3;8
44;66


Thanks and Regards

 

[Peter_SSs]

The string of numbers could start in say cell A1 and they could be as follows:

9, 4, 8, 208, 44, 242, 6 etc

Would those numbers all be in cell A1 or does that represent A1, B1, C1, D1, etc... or something else.

Have you considered using XL2BB for sample data? It makes layout etc much clearer?

 

[cotech_10]

Would those numbers all be in cell A1 or does that represent A1, B1, C1, D1, etc... or something else.

Have you considered using XL2BB for sample data? It makes layout etc much clearer?

Hi Peter,

Yes the first number would start in cell A1 the next number in B1, then C1, D1, etc

Thanking You

 

[cotech_10]

new single number.xlsm
	A	B	C	D	E	F	G	H
1	9	4	8	208	44	242	6
2	9;106
3	130;137
4	4;50
5	29;295
6	3;6
7	1;8
8	8;26
9	242;335
10	208;204
11	3;5
12	16;100
13	2;90
14	3;8
15	44;66
16
17
18
Sheet1

 

[Peter_SSs]

Thanks for using XL2BB - makes it much easier.

Try this version.

Sub Colour_Font_v2()
  Dim a As Variant, Nums As Variant
  Dim i As Long, j As Long, pos As Long
  Dim s As String
  
  Nums = Split(";" & Join(Application.Index(Range("A1").Resize(, Cells(1, Columns.Count).End(xlToLeft).Column).Value, 1, 0), "; ;") & ";")
  With Range("A2", Range("A" & Rows.Count).End(xlUp))
    a = .Value
    For i = 1 To UBound(a)
      s = ";" & a(i, 1) & ";"
      For j = 0 To UBound(Nums)
        pos = InStr(1, s, Nums(j))
        If pos > 0 Then .Cells(i, 1).Characters(pos, Len(Nums(j)) - 2).Font.Color = vbRed
      Next j
    Next i
  End With
End Sub

 

[cotech_10]

Thanks for using XL2BB - makes it much easier.

Try this version.

Sub Colour_Font_v2()
  Dim a As Variant, Nums As Variant
  Dim i As Long, j As Long, pos As Long
  Dim s As String
 
  Nums = Split(";" & Join(Application.Index(Range("A1").Resize(, Cells(1, Columns.Count).End(xlToLeft).Column).Value, 1, 0), "; ;") & ";")
  With Range("A2", Range("A" & Rows.Count).End(xlUp))
    a = .Value
    For i = 1 To UBound(a)
      s = ";" & a(i, 1) & ";"
      For j = 0 To UBound(Nums)
        pos = InStr(1, s, Nums(j))
        If pos > 0 Then .Cells(i, 1).Characters(pos, Len(Nums(j)) - 2).Font.Color = vbRed
      Next j
    Next i
  End With
End Sub

Hi Peter,

No problem about using XL2BB... nice little tool indeed of course and nothing like seeing the end product. makes it more clear...

I have run the script and works like a dream..!!! awesome effort.!!!

Thanking You much appreciated...

 

[Peter_SSs]

You're welcome. Thanks for the follow-up.