I have a number of cells (D4:D39) containing event descriptions followed by 3 digit codes and I want to colour these codes differently depending on which group they belong to
[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD][/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]ALL Groups
ABC - DEF - PQR - VWX - 21E - XY2[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]GROUPS2 and 3
MNO - STU - A1C - XY2[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]GROUP1, 2 and 4
GHI - PQR - 12D - 45S - 61D[/TD]
[/TR]
[TR]
[TD]...[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
For example
Group1 consists of ABC, DEF, GHI, JKL - I want to colour these individual strings GREEN when they are present
Group2 consists of MNO, PQR, STU - I want to colour these individual strings RED when they are present
Group3 consists of VWX, YZ1, XY2, A1C - I want to colour these individual strings BLUE when they are present
Group4 consists of 12D, 21E, 34D, 45S, 61D - I want to colour these individual strings ORANGE when they are present
I have found the ColorMyWord() VBA script which can achieve this but it uses CASE statements so I would need to write around 80 CASE seperate case statements to cover all of the different 3 digit codes.
Can this code be re-written so the 3 digit codes to search for are given in arrays (such as below)?
Array1 "ABC", "DEF", "GHI", "JKL"
Array2 "MNO", "PQR", "STU"
Array3 "VWX", "YZ1", "XY2", "A1C"
Array4 "12D", "21E", "34D", "45S", "61D"
[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD][/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]ALL Groups
ABC - DEF - PQR - VWX - 21E - XY2[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]GROUPS2 and 3
MNO - STU - A1C - XY2[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]GROUP1, 2 and 4
GHI - PQR - 12D - 45S - 61D[/TD]
[/TR]
[TR]
[TD]...[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
For example
Group1 consists of ABC, DEF, GHI, JKL - I want to colour these individual strings GREEN when they are present
Group2 consists of MNO, PQR, STU - I want to colour these individual strings RED when they are present
Group3 consists of VWX, YZ1, XY2, A1C - I want to colour these individual strings BLUE when they are present
Group4 consists of 12D, 21E, 34D, 45S, 61D - I want to colour these individual strings ORANGE when they are present
I have found the ColorMyWord() VBA script which can achieve this but it uses CASE statements so I would need to write around 80 CASE seperate case statements to cover all of the different 3 digit codes.
Code:
Option Explicit
Sub ColorMyWord()
Dim startChar As Integer, _
lenColor As Integer, _
nxtWord As Integer
Dim w As Range, _
myRange As Range
Dim dRed As Integer, _
dBlue As Integer, _
dGreen As Integer
Dim firstAddress As String, _
srchWord As String
Set myRange = Sheets("Events").Range("D4:D39")
'Reset all colors in D4:D39
myRange.Font.ColorIndex = xlAutomatic
'Loop through 6 Cases, setting search word and RGB color codes
For nxtWord = 1 To 6
Select Case nxtWord
Case 1
srchWord = "VWX"
dRed = 0
dBlue = 112
dGreen = 192 'Blue
Case 2
srchWord = "ABC"
dRed = 0
dBlue = 176
dGreen = 80 'Green
Case 3
srchWord = "12D"
dRed = 237
dBlue = 125
dGreen = 49 'Orange
Case 4
srchWord = "MNO"
dRed = 255
dBlue = 0
dGreen = 0 'FF0000 Red
End Select
'Find search words and set font color
With myRange
Set w = .Find(srchWord, lookat:=xlPart, MatchCase:=True)
If Not w Is Nothing Then
firstAddress = w.Address
Do
startChar = InStr(1, w, srchWord)
lenColor = Len(srchWord)
w.Characters(Start:=startChar, Length:=lenColor).Font.Color = _
RGB(dRed, dBlue, dGreen)
Set w = .FindNext(w)
Loop While Not w Is Nothing And w.Address <> firstAddress
End If
End With
Next
End Sub
Can this code be re-written so the 3 digit codes to search for are given in arrays (such as below)?
Array1 "ABC", "DEF", "GHI", "JKL"
Array2 "MNO", "PQR", "STU"
Array3 "VWX", "YZ1", "XY2", "A1C"
Array4 "12D", "21E", "34D", "45S", "61D"