Coloring based in line B3:G3 items

9/5/2013

9/3/2013

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.

9/3/2013

ASKER

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

9/3/2013

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

9/3/2013

ASKER

I prefer a script that does the job itself.

9/3/2013

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

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

ATb
Steve.
GroupColoring.xlsm

9/3/2013

ASKER

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.

9/3/2013

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

9/4/2013

ASKER

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.

9/4/2013

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.

9/4/2013

ASKER

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.

9/4/2013

ASKER

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

9/4/2013

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 :)

9/4/2013

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

Does this do it?
GroupColoring.xlsm

9/4/2013

ASKER

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.

9/4/2013

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

GroupColoring.xlsm

9/4/2013

ASKER

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

9/4/2013

THIS SOLUTION IS ONLY AVAILABLE TO MEMBERS.

View this solution by signing up for a free trial.

Members can start a 7-Day free trial and enjoy unlimited access to the platform.

See Pricing Options

Start Free Trial

9/5/2013

ASKER

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?

9/5/2013

ASKER

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.

9/5/2013

ASKER

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.