Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
![]()
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:D" & 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. -- Win XP PRof SP2 / Vista Ultimate SP2 Office 2003 SP2 /2007 Ultimate SP2 |
#2
![]()
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
![]()
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:D" & 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. -- Win XP PRof SP2 / Vista Ultimate SP2 Office 2003 SP2 /2007 Ultimate SP2 |
#3
![]()
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
![]()
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:D" & 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. -- Win XP PRof SP2 / Vista Ultimate SP2 Office 2003 SP2 /2007 Ultimate SP2 |
#4
![]()
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
![]()
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. -- Win XP PRof SP2 / Vista Ultimate SP2 Office 2003 SP2 /2007 Ultimate SP2 |
#5
![]()
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
![]()
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:D" & 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. -- Win XP PRof SP2 / Vista Ultimate SP2 Office 2003 SP2 /2007 Ultimate SP2 |
#6
![]()
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
![]()
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:D" & 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. -- Win XP PRof SP2 / Vista Ultimate SP2 Office 2003 SP2 /2007 Ultimate SP2 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
conditional formatting to group rows with repeating entries | Excel Discussion (Misc queries) | |||
conditional formatting group of cells | Excel Discussion (Misc queries) | |||
How to apply conditional formatting on group of cells by using dat | Excel Discussion (Misc queries) | |||
Average a group, where grouping is Conditional on other col.??? | Excel Discussion (Misc queries) | |||
Formatting a group of cells for text | Excel Discussion (Misc queries) |