Avatar of Pedro
Pedro asked on

Coloring Three Group Numbers

The goal is to highlight numbers based the associated groups. For instance, all numbers in the "B" group are colored red, C is colored green and D is colored blue. Note: you may have to change the color of the number from black to white or another color in order for it to be visible.

The groups are located in the Update sheet while the actual coloring occurs in the Numbers sheet. Prefereably, let me select the numbers to color. For instance, Group if B3:F1628 is selected then only numbers in B:F are colored and none other. In this instance, the coloring occurs based where the numbers is in the Update sheet.

The first line is provided as a sample of the intended result in any chosen cell groups. Also included is a script that accomplishes the task but it is too slow when run on multiple cells. If you use the enclosed script please make it faster. Also, it was programmed for an older version of excel in case that helps any.
Group3Coloring.xlsm
VB ScriptMicrosoft Excel

Avatar of undefined
Last Comment
redmondb

8/22/2022 - Mon
Ejgil Hedegaard

Use conditional formatting, that is fast.
The 3 numbercolumns on Update are named Group1 for B4:B25, Group2 for C4:C25 and Group3 for D4:D25.
The conditional formula for first colour is =ISERROR(MATCH(B3,Group1,0))=FALSE
Similar for the other 2.
See attached file, not sure colours are excactly match, downsized to 30 rows, copy B3 to your actual file and change the conditional range to column G and row 142509
Group3Coloring-small-sample.xlsx
ASKER
Pedro

OK, just a heads up. I did not write the code and am not a programmer so it is best if you write the code that runs faster much faster and let me run it on a large group to see how much faster it is.
redmondb

Hi, Pedro.

Please try the code below. (For the moment, it  does all used rows in "Numbers" (excluding rows 1 & 2) for columns B to G.)

Regards,
Brian.
Option Explicit

Option Base 0

Sub Colour_Numbers()
Dim i           As Long
Dim j           As Long
Dim xLast_Row   As Long
Dim xArray1     As Variant
Dim xArray2     As Variant
Dim xArray3     As Variant
Dim Xall        As Variant
Dim StartTime   As Variant
Dim xNumbers    As Worksheet

StartTime = Timer

Set xNumbers = Sheets("Numbers")

xLast_Row = xNumbers.UsedRange.Cells(1, 1).Row + xNumbers.UsedRange.Rows.Count - 1
If xLast_Row < 3 Then
    MsgBox ("No data found in the ""Numbers"" Sheet - run cancelled.")
    Exit Sub
End If

xArray1 = [Update!B4:B25]
xArray2 = [Update!C4:C25]
xArray3 = [Update!D4:D25]

Application.ScreenUpdating = False

    'Set default to first category...
    xNumbers.Range("B3:G" & xLast_Row).Interior.ColorIndex = 3
    xNumbers.Range("B3:G" & xLast_Row).Font.ColorIndex = 2
    xNumbers.Range("B3:G" & xLast_Row).Font.Bold = True
    
    Xall = xNumbers.Range("B1:G" & xLast_Row)
        
    For i = 3 To xLast_Row
        For j = 1 To 6
            Select Case Xall(i, j)
                Case xArray1(1, 1), xArray1(2, 1), xArray1(3, 1), xArray1(4, 1), xArray1(5, 1), xArray1(6, 1), xArray1(7, 1), xArray1(8, 1), xArray1(9, 1), xArray1(10, 1) _
                    , xArray1(11, 1), xArray1(12, 1), xArray1(13, 1), xArray1(14, 1), xArray1(15, 1), xArray1(16, 1), xArray1(17, 1), xArray1(18, 1), xArray1(19, 1), xArray1(20, 1) _
                    , xArray1(21, 1), xArray1(22, 1)
                    ' Nothing to do as this is the default.
                Case xArray2(1, 1), xArray2(2, 1), xArray2(3, 1), xArray2(4, 1), xArray2(5, 1), xArray2(6, 1), xArray2(7, 1), xArray2(8, 1), xArray2(9, 1), xArray2(10, 1) _
                    , xArray2(11, 1), xArray2(12, 1), xArray2(13, 1), xArray2(14, 1), xArray2(15, 1), xArray2(16, 1), xArray2(17, 1), xArray2(18, 1), xArray2(19, 1), xArray2(20, 1) _
                    , xArray2(21, 1), xArray2(22, 1)
                    xNumbers.Cells(i, j + 1).Interior.ColorIndex = 4
                    xNumbers.Cells(i, j + 1).Font.ColorIndex = 1
                Case xArray3(1, 1), xArray3(2, 1), xArray3(3, 1), xArray3(4, 1), xArray3(5, 1), xArray3(6, 1), xArray3(7, 1), xArray3(8, 1), xArray3(9, 1), xArray3(10, 1) _
                    , xArray3(11, 1), xArray3(12, 1), xArray3(13, 1), xArray3(14, 1), xArray3(15, 1), xArray3(16, 1), xArray3(17, 1), xArray3(18, 1), xArray3(19, 1), xArray3(20, 1) _
                    , xArray3(21, 1), xArray3(22, 1)
                    xNumbers.Cells(i, j + 1).Interior.ColorIndex = 14
                Case Else
                    xNumbers.Cells(i, j + 1).Interior.ColorIndex = xlNone
                    xNumbers.Cells(i, j + 1).Font.ColorIndex = 1
                    xNumbers.Cells(i, j + 1).Font.Bold = False
            End Select
        Next
    Next
    
Application.ScreenUpdating = True

Debug.Print "Processed " & i - 2 & " rows of " & xLast_Row & " - " & Format(Timer - StartTime, "000") & " seconds."
MsgBox ("Processed " & i - 2 & " rows of " & xLast_Row & " - " & Format(Timer - StartTime, "000") & " seconds.")

End Sub

Open in new window

Experts Exchange has (a) saved my job multiple times, (b) saved me hours, days, and even weeks of work, and often (c) makes me look like a superhero! This place is MAGIC!
Walt Forbes
ASKER
Pedro

Redmond,

Excellen work, as usual. However, please allow me to choose which cells to color since I may not want or need all of them.

Best Regards,
Pedro
ASKER CERTIFIED SOLUTION
redmondb

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
See how we're fighting big data
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
ASKER
Pedro

I would like to run both scripts from the same excel file. I noticed on top the following:

Option Explicit

Option Base 0

does not stay within the script. There is a line that separates the above from the rest of the script will this affect how the script works in any way?

Other than that Great Job!

P.S. I ran both scripts from the same xlsm file and they seem to work fine. I'd just like to get your approval since you're the programmer and know what effect, if any, this has.
redmondb

Pedro,

They may only appear at the start of a Module (and there may only be one of each.)  

"Option Explicit" tells Excel to check that all variables have been Dim'ed. While not compulsory, it's hugely valuable. For example, it will catch misspellings (such as "W0RK" instead of "WORK"). You should always use it - in fact one of the settings is "Require Variable Declaration" which will automatically add the line to any new Module.

"Option Base 0" specifies that the first element of standard arrays is zero. It's the default, but I always specify it when I'm using an arrary (it's a warning for someone else who may subsequently want to add an "Option Base 1".) In this case, it's doubly unnecessary - the macro no longer uses standard arrays.

So, yes, the two Macros can happily live in the same Module - just add an "Option Explicit" before the first one.

Regards,
Brian.
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
ASKER
Pedro

At this point, I think you are doing such an excellent job that words simply cannot express ...
redmondb

Thanks! Glad to help, Pedro!
ASKER
Pedro

Redmond:

Just a heads up. Since you did such a great job here you may want take a look at my recent post. ID28229695.

I think the script you posted here just needs to be tweeked a little and it would do the trick.

Best Regards,
Pedro
Experts Exchange is like having an extremely knowledgeable team sitting and waiting for your call. Couldn't do my job half as well as I do without it!
James Murphy
redmondb

Thanks, Pedro. However, you're in good hands there, so I won't interfere.

Regards,
Brian.