Conditional Formatting from a group

[wabbleknee]

Trying to make this an auto function, currently doing it manually. I
receive a daily list of "customers" that in one column has a number that
codes each customer by what was done for them. These codes look like
"123.45, 123.78, 789.123, 999.001 etc". There are maybe 100 codes total and
15 codes that I want to fall into a group. What has to happen is to "flag"
(specific color) these codes out into 3 different groups. These groups may
be any code that starts with "123","789"or "999" etc. The numbers to the
right of the decimal point does not control what group they go into, only
the 3 numbers to the left of the decimal point. Lets assume the the 123
group will be the red group, 789 group is green group, 999 group is blue etc

i.e. to further to clarify, (confuse)

Any number that begins with xx will be in the red group
xx = 123, 222, 541,346,718 up to 15 numbers here

Any number that begins with yy will be in the green group
yy = 789, 790, 791, 212, up to 15 numbers here

123.456, 123.001, 123.766, 222.100 etc gets filled in as red
789.123, 789.444, 789.345, 790.444 etc gets filled in as green

456.111, 333.567 etc does not get any formatting.

same for the 3rd group (blue)

"IF" conditions are way out of control, tried looking at a look up table
and somehow using that but getting bogged down. I made a table populated
with the numbers for the "RED" group, same for green and blue.

Original data comes in 15 column format, the "Code" will be in column "D"
and that cell is the one that will get the conditional format, rows vary,
maybe 10-50 total a day. I could get away with inserting a "FLAG" column
next to the code if necessary.

Tx for any guidance.

 

[Claus Busch]

Hi,

Am Thu, 10 Oct 2013 15:56:11 -0400 schrieb wabbleknee:

Any number that begins with xx will be in the red group
xx = 123, 222, 541,346,718 up to 15 numbers here

Any number that begins with yy will be in the green group
yy = 789, 790, 791, 212, up to 15 numbers here

123.456, 123.001, 123.766, 222.100 etc gets filled in as red
789.123, 789.444, 789.345, 790.444 etc gets filled in as green

substrings only can be colored by VBA.
Modify following code to your wishes:

Sub Color()
Dim arrGreen As Variant
Dim arrRed As Variant
Dim arrBlue As Variant
Dim rngC As Range
Dim LRow As Long
Dim i As Integer
Dim n As Integer
Dim intStart As Integer
Dim intLen As Integer

arrGreen = Array(789, 790, 791, 212)
arrRed = Array(123, 222, 541, 346, 718)
LRow = Cells(Rows.Count, 4).End(xlUp).Row
For Each rngC In Range("D1" & LRow)
For i = LBound(arrGreen) To UBound(arrGreen)
For n = 1 To Len(rngC)
intStart = InStr(n, rngC, arrGreen(i) & ".")
If intStart > 0 Then
intLen = InStr(intStart, rngC, ",") - intStart
rngC.Characters(intStart, intLen).Font.Color = vbGreen
End If
Next
Next
For i = LBound(arrRed) To UBound(arrRed)
For n = 1 To Len(rngC)
intStart = InStr(n, rngC, arrRed(i) & ".")
If intStart > 0 Then
intLen = InStr(intStart, rngC, ",") - intStart
rngC.Characters(intStart, intLen).Font.Color = vbRed
End If
Next
Next
Next
End Sub


Regards
Claus B.

 

[Claus Busch]

Hi again,

Am Thu, 10 Oct 2013 22:37:50 +0200 schrieb Claus Busch:

substrings only can be colored by VBA.
Modify following code to your wishes:

a little bit faster:

Sub Color()
Dim arrGreen As Variant
Dim arrRed As Variant
Dim arrBlue As Variant
Dim rngC As Range
Dim LRow As Long
Dim i As Integer
Dim n As Integer
Dim intStart As Integer
Dim intLen As Integer

arrGreen = Array(789, 790, 791, 212)
arrRed = Array(123, 222, 541, 346, 718)
LRow = Cells(Rows.Count, 4).End(xlUp).Row
For Each rngC In Range("D1" & LRow)
For i = LBound(arrGreen) To UBound(arrGreen)
For n = 1 To Len(rngC)
intStart = InStr(n, rngC, arrGreen(i) & ".")
If intStart > 0 Then
intLen = InStr(intStart, rngC, ",") - intStart
rngC.Characters(intStart, intLen).Font.Color = vbGreen
n = n + intStart + intLen
End If
Next
Next
For i = LBound(arrRed) To UBound(arrRed)
For n = 1 To Len(rngC)
intStart = InStr(n, rngC, arrRed(i) & ".")
If intStart > 0 Then
intLen = InStr(intStart, rngC, ",") - intStart
rngC.Characters(intStart, intLen).Font.Color = vbRed
n = n + intStart + intLen
End If
Next
Next
Next
End Sub


Regards
Claus B.

 

[wabbleknee]

Thank you Claus....working with it now.

"Claus Busch" wrote in message
Hi again,

Am Thu, 10 Oct 2013 22:37:50 +0200 schrieb Claus Busch:

substrings only can be colored by VBA.
Modify following code to your wishes:

a little bit faster:

Sub Color()
Dim arrGreen As Variant
Dim arrRed As Variant
Dim arrBlue As Variant
Dim rngC As Range
Dim LRow As Long
Dim i As Integer
Dim n As Integer
Dim intStart As Integer
Dim intLen As Integer

arrGreen = Array(789, 790, 791, 212)
arrRed = Array(123, 222, 541, 346, 718)
LRow = Cells(Rows.Count, 4).End(xlUp).Row
For Each rngC In Range("D1" & LRow)
For i = LBound(arrGreen) To UBound(arrGreen)
For n = 1 To Len(rngC)
intStart = InStr(n, rngC, arrGreen(i) & ".")
If intStart > 0 Then
intLen = InStr(intStart, rngC, ",") - intStart
rngC.Characters(intStart, intLen).Font.Color = vbGreen
n = n + intStart + intLen
End If
Next
Next
For i = LBound(arrRed) To UBound(arrRed)
For n = 1 To Len(rngC)
intStart = InStr(n, rngC, arrRed(i) & ".")
If intStart > 0 Then
intLen = InStr(intStart, rngC, ",") - intStart
rngC.Characters(intStart, intLen).Font.Color = vbRed
n = n + intStart + intLen
End If
Next
Next
Next
End Sub


Regards
Claus B.

 

[Claus Busch]

Hi,

Am Fri, 11 Oct 2013 13:37:26 -0400 schrieb wabbleknee:

Thank you Claus....working with it now.

you have to fill the arrays and create the arrBlue
I could not do it because I have no data.


Regards
Claus B.

 

[Claus Busch]

Hi again,

Am Fri, 11 Oct 2013 13:37:26 -0400 schrieb wabbleknee:

working with it now.

here it is now with arrBlue. You only have to fill all your numbers to
the arrays:

Sub Color()
Dim arrGreen As Variant
Dim arrRed As Variant
Dim arrBlue As Variant
Dim rngC As Range
Dim LRow As Long
Dim i As Integer
Dim n As Integer
Dim intStart As Integer
Dim intLen As Integer

arrGreen = Array(789, 790, 791, 212)
arrRed = Array(123, 222, 541, 346, 718)
arrBlue = Array(999)
LRow = Cells(Rows.Count, 4).End(xlUp).Row
For Each rngC In Range("D1" & LRow)
For i = LBound(arrGreen) To UBound(arrGreen)
For n = 1 To Len(rngC)
intStart = InStr(n, rngC, arrGreen(i) & ".")
If intStart > 0 Then
intLen = InStr(intStart, rngC, ",") - intStart
rngC.Characters(intStart, intLen).Font.Color = vbGreen
n = n + intStart + intLen
Else
Exit For
End If
Next
Next
For i = LBound(arrRed) To UBound(arrRed)
For n = 1 To Len(rngC)
intStart = InStr(n, rngC, arrRed(i) & ".")
If intStart > 0 Then
intLen = InStr(intStart, rngC, ",") - intStart
rngC.Characters(intStart, intLen).Font.Color = vbRed
n = n + intStart + intLen
Else
Exit For
End If
Next
Next
For i = LBound(arrBlue) To UBound(arrBlue)
For n = 1 To Len(rngC)
intStart = InStr(n, rngC, arrBlue(i) & ".")
If intStart > 0 Then
intLen = InStr(intStart, rngC, ",") - intStart
rngC.Characters(intStart, intLen).Font.Color = vbBlue
n = n + intStart + intLen
Else
Exit For
End If
Next
Next
Next
End Sub


Regards
Claus B.

 

[wabbleknee]

Claus, Understand. Tx Again. Will be modifying the array's with the real
numbers and will be able to easily change if "they" want to add a new number
group. I also discovered that the "corporate" computer formatted all the
numbers as TEXT before I get a copy.

"Claus Busch" wrote in message
Hi again,

Am Fri, 11 Oct 2013 13:37:26 -0400 schrieb wabbleknee:

working with it now.

here it is now with arrBlue. You only have to fill all your numbers to
the arrays:

Sub Color()
Dim arrGreen As Variant
Dim arrRed As Variant
Dim arrBlue As Variant
Dim rngC As Range
Dim LRow As Long
Dim i As Integer
Dim n As Integer
Dim intStart As Integer
Dim intLen As Integer

arrGreen = Array(789, 790, 791, 212)
arrRed = Array(123, 222, 541, 346, 718)
arrBlue = Array(999)
LRow = Cells(Rows.Count, 4).End(xlUp).Row
For Each rngC In Range("D1" & LRow)
For i = LBound(arrGreen) To UBound(arrGreen)
For n = 1 To Len(rngC)
intStart = InStr(n, rngC, arrGreen(i) & ".")
If intStart > 0 Then
intLen = InStr(intStart, rngC, ",") - intStart
rngC.Characters(intStart, intLen).Font.Color = vbGreen
n = n + intStart + intLen
Else
Exit For
End If
Next
Next
For i = LBound(arrRed) To UBound(arrRed)
For n = 1 To Len(rngC)
intStart = InStr(n, rngC, arrRed(i) & ".")
If intStart > 0 Then
intLen = InStr(intStart, rngC, ",") - intStart
rngC.Characters(intStart, intLen).Font.Color = vbRed
n = n + intStart + intLen
Else
Exit For
End If
Next
Next
For i = LBound(arrBlue) To UBound(arrBlue)
For n = 1 To Len(rngC)
intStart = InStr(n, rngC, arrBlue(i) & ".")
If intStart > 0 Then
intLen = InStr(intStart, rngC, ",") - intStart
rngC.Characters(intStart, intLen).Font.Color = vbBlue
n = n + intStart + intLen
Else
Exit For
End If
Next
Next
Next
End Sub


Regards
Claus B.