Avatar of Pedro
Pedro asked on

Coloring based in line B3:G3 items

The idea here is to color all of the items following line 3 using the same color as the item itself. For instance, B31=31, thus any time the number 31 is found below  it is colored the same as it. NOTE: a different color is used for the value in C3 another for D3 another for E3 and F3 and G3.

I would like to be able to do the following:

1) coloring is done based on the numbers in B3:G3.
2) The script should prompt me or let me choose a range on numbers so that
          a) if B3:F40 are chosen then the number in G3 remains with no color.
           b) only the numbers in the chosen cells are colored.
3) if B3:G3 are blank then all of the chosen cells are returned to their original white background and black lettering. This allows me to 'reset' the page. Unless, of course if you have a better idea then by all means use it.
Microsoft ApplicationsVB ScriptMicrosoft Excel

Avatar of undefined
Last Comment
Pedro

8/22/2022 - Mon
Steve

I think I have a vague idea of what you are looking to do, which is achievable.
but what would really help would be a sample mock workbook.
This, with some lines of explanation, would help tailor the solution to your needs.

ATB
Steve.
ASKER
Pedro

OMG, it failed to upload again! Sorry about that, here's the sample.
GroupColoring.xlsx
Steve

Before I write code to handle sheet change events, are you familiar with conditional formatting? Could this be a solution.

If not I can code to do the colour changes, but CF is better imo.

In the example use Conditional formatting > manage rules > Whole sheet to see rules.
GroupColoring.xlsx
I started with Experts Exchange in 2004 and it's been a mainstay of my professional computing life since. It helped me launch a career as a programmer / Oracle data analyst
William Peck
ASKER
Pedro

I prefer a script that does the job itself.
Steve

OK,
1) apply the colour to the first 6 cells (or none if you like)
2) select the range to apply the colour code to
3) run the code in the workbook as below...

Sub ApplyColour()

Dim d As Object
Set d = CreateObject("Scripting.Dictionary")

Dim r As Range

Set Baserange = Range("B3:G3")
For Each r In Baserange.Cells
    If Not d.Exists(r.Value) Then
        d.Add r.Value, r.Interior.Color
    End If
Next r

For Each r In Selection.Cells
    If d.Exists(r.Value) Then
        If d.Item(r.Value) = 16777215 Then
            r.Interior.Pattern = xlNone
        Else
            r.Interior.Color = d.Item(r.Value)
        End If
    End If
Next r

End Sub

Open in new window


If you need more doing just say.
but this is a start.

ATb
Steve.
GroupColoring.xlsm
ASKER
Pedro

Steve,

Ran macro 1 and got a "Compile error: Invalid or unqualified reference" pointing to .Color = 255

Ran macro 2 and got a Run-time error '424': Object required

The ApplyColour script does nothing that I can see. The intent is to color the numbers using the numbers in B3:G3.
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
Steve

After applying a colour to the cells in range B3:G3 run the macro.

I had set it to run on the selected range.
but now it will ask you to select a range to apply the colour to.

The other two macro were me building the code, I forgot to delete them.
GroupColoring.xlsm
ASKER
Pedro

Looks like we're almost there. It does not color F or G numbers even though I have selected that row. In other words is the selection includes column F then the number in F3 is supposed to be colored also. If the number in G3 is selected then that number is also colored when it is found in the selection.
Steve

Could you provide an example of what you mean...

The macro at the moment will:
1) look at B3 to G3 and store the number in the cell and the colour of that cell.
2) allow you to select a range
3) colour each cell in the selected range pt2 based upon the colours stored in pt1.

So if you have colours in G3 it will be applied to all matching cells in the selected range.

Could you explain what is happening which is not as desired.
thanks,
Steve.
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
ASKER
Pedro

Ok, I see, you're assuming that the cells B3:G3 already have a color. In the original worksheet they do not and that is where the script comes in. The script denotes a different color for each selected cell and then when it finds that same number anywhere else in the selection it colors it the same as the original color.

Therefore, if cells C3:G3 are blank they can be used 'clear' the previously colored cells. When cells contain numbers a different color is assigned to each number. Hopefully that clarifies things for you.
ASKER
Pedro

Here's a sample script except that this one works too slow for me although it does what I would like. Maybe that helps to clarify things more.

Sub Numbers()
Dim MyCell As Range, rgHighlight As Range, rg1 As Range, rg2 As Range, rg3 As Range, rg4 As Range, rg5 As Range, rg6 As Range
  
Application.ScreenUpdating = False
Set rg1 = [B3]   'Highlight values that match these cells
Set rg2 = [C3]   'Highlight values that match these cells in
Set rg3 = [D3]   'Highlight values that match these cells in
Set rg4 = [E3]   'Highlight values that match these cells in
Set rg5 = [F3]   'Highlight values that match these cells in
Set rg6 = [G3]   'Highlight Mega Ball value in dark cyan

'Set rgHighlight = Selection
Set rgHighlight = [B2:F1000]

'Loop using a For Each…Next in selection
    For Each MyCell In Selection
        If Application.CountIf(rg1, MyCell) > 0 Then
            'Set the No 1 cell background color to First Number
            MyCell.Interior.ColorIndex = 3
            MyCell.Font.ColorIndex = 2
            MyCell.Font.Bold = True

        ElseIf Application.CountIf(rg2, MyCell) > 0 Then
            'Set the No 2 cell background color to second Number
            MyCell.Interior.ColorIndex = 4
            MyCell.Font.ColorIndex = 2
            MyCell.Font.Bold = True
            
        ElseIf Application.CountIf(rg3, MyCell) > 0 Then
            'Set the No 3 cell background color to Third Number
            MyCell.Interior.ColorIndex = 14   'Cyan is 8, yellow is 6 (but hard to read)
            MyCell.Font.ColorIndex = 2
            MyCell.Font.Bold = True
            
        ElseIf Application.CountIf(rg4, MyCell) > 0 Then
            'Set the No 2 cell background color to Fourth Number
            MyCell.Interior.ColorIndex = 12
            MyCell.Font.ColorIndex = 2
            MyCell.Font.Bold = True
            
        ElseIf Application.CountIf(rg5, MyCell) > 0 Then
            'Set the No 3 cell background color to Fifth Number
            MyCell.Interior.ColorIndex = 13
            MyCell.Font.ColorIndex = 2
            MyCell.Font.Bold = True
            
        'ElseIf Application.CountIf(rg6, MyCell) > 0 Then
            'Set the No 3 cell background color to Sixth Number
            'MyCell.Interior.ColorIndex = 11
            'MyCell.Font.ColorIndex = 2
            'MyCell.Font.Bold = True
         
        Else
            'Set other background color to white with black letters
            MyCell.Interior.ColorIndex = xlNone
            MyCell.Font.ColorIndex = 1
            MyCell.Font.Bold = False
        'Else
            'Set the cell background color to blue
            'MyCell.Interior.ColorIndex = 9
            'MyCell.Font.ColorIndex = 2
            'MyCell.Font.Bold = True
        End If
    Next

Application.ScreenUpdating = True
End Sub

Open in new window

Steve

Ahha, the bit I was missing was that the formatting is already hard coded.
As I was not aware of this I was assuming that the first row was used as a "master".

I shall re-code accordingly... watch this space :)
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
Steve

OK, this should run a tad faster than that old code:

Sub ApplyColour()

Application.ScreenUpdating = False

Dim d As Object
Set d = CreateObject("Scripting.Dictionary")

Dim r As Range, c As Range

Dim BaseColours
BaseColours = Array(3, 4, 14, 12, 13, 11)

Set Baserange = Range("B3:G3")
For Each r In Baserange.Cells
    If Not d.Exists(r.Value) Then
        x = x + 1
        d.Add r.Value, x
    End If
Next r

Set c = [B2:G1000]

c.Interior.ColorIndex = xlNone
c.Font.ColorIndex = 1
c.Font.Bold = False

For Each r In c.Cells
    If d.Exists(r.Value) Then
        r.Interior.ColorIndex = BaseColours(d.Item(r.Value) - 1)
        r.Font.ColorIndex = 2
        r.Font.Bold = True
    End If
Next r

Application.ScreenUpdating = True

End Sub

Open in new window


Does this do it?
GroupColoring.xlsm
ASKER
Pedro

1) I get a compile error: Variable not defined and it points to: Set Baserange = Range("B3:G3")

2) I noticed in your code that B2:g1000 is static. If this sets the rows to color then we're not quite there yet. Please remember I would like to "choose the rows and columns" to color.

I do not know how the old code does this but before running the old code I have to select the cells to color otherwise it does not color anything.
Steve

OK, the compile error is due to the Option Explicit you had at the top (I didn't)

The following should do it ?

Option Explicit

Sub ApplyColour()


Dim x As Long
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")

Dim r As Range, c As Range

Dim BaseColours
BaseColours = Array(3, 4, 14, 12, 13, 11)

Dim BaseRange As Range
Set BaseRange = Range("B3:G3")
For Each r In BaseRange.Cells
    If Not d.Exists(r.Value) Then
        x = x + 1
        d.Add r.Value, x
    End If
Next r

Set c = Application.InputBox(Prompt:="Please Select Range", Title:="Range Select", Type:=8)

Application.ScreenUpdating = False

c.Interior.ColorIndex = xlNone
c.Font.ColorIndex = 1
c.Font.Bold = False

For Each r In c.Cells
    If d.Exists(r.Value) Then
        r.Interior.ColorIndex = BaseColours(d.Item(r.Value) - 1)
        r.Font.ColorIndex = 2
        r.Font.Bold = True
    End If
Next r

Application.ScreenUpdating = True

End Sub

Open in new window

GroupColoring.xlsm
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

One more bug. When B3:G3 are blank it does clear cell colors except that B3:G3 is colored red and it should not be.

Don't know if this matters but when I click to cancel when it prompts with selection,
      Run-time error '424': Object required comes up and it highlights the following:

Set c = Application.InputBox(Prompt:="Please Select Range", Title:="Range Select"
ASKER CERTIFIED SOLUTION
Steve

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

Almost there.

I highlighted B3:F3 and it colors the number in G3 even though it is not highlighted. The idea is to search for and color only the selected columns since I did not select G3 I do not want that number colored in when it is found. I hope that clarifies things.

Is it possible to automatically only choose the selected numbers? or is the selection static?
ASKER
Pedro

P.S. in the old program I had to manually edit the script to do that. If I need to do that here let me know which lines and what to put in. I am hoping the script can do the selection automatically.
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
ASKER
Pedro

PPS. I think you deserve more points for more work. I will credit you for this session and post again requesting the changes I have outlined above. I hope you will agree to change the coding in that case instead of letting someone else get those points.
ASKER
Pedro

Excellent work. Thank you for your time and patience.