VBA code

The Idea Dude

Well-known Member
Joined
Aug 15, 2002
Messages
591
Office Version
  1. 2016
Platform
  1. Windows
What code would do the following?

There are 5 numbers in different cells (These numbers can change)

A1=2,
A2=6,
A3=9,
A4=35,
A5=3

I need to allocate one colour to the highest number, a different colour to the next highest and so on.

Any suggestions?
This message was edited by The Idea Dude on 2002-09-11 03:49
 
Jay,

Thanks for the compliment.

There was a pattern in the colours, but I deliberately used a case structure so that the OP could easily change the code to choose his own colours if mine didn't suit.
 
Upvote 0

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Thanks to andrew for this piece of code

Sub Colours()
Dim Rng As Range
Dim c As Range
Dim x As Long
Set Rng = Range("B11:B15")
For Each c In Rng
x = Application.Rank(c.Value, Rng)
Select Case x
Case 1: c.Font.ColorIndex = 3
Case 2: c.Font.ColorIndex = 7
Case 3: c.Font.ColorIndex = 10
Case 4: c.Font.ColorIndex = 5
Case 5: c.Font.ColorIndex = 9
End Select
Next c

My question now is, how do I make this proceedure run when both

a) font colour in the range is not equal to 1, and
b) the value in cell R17 changes.

Thanks for the fantastic help
This message was edited by The Idea Dude on 2002-09-11 20:20
 
Upvote 0
Like this:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$A" Then Exit Sub
    Application.EnableEvents = False
    Call Colours
    Application.EnableEvents = True
End Sub

Sub Colours()
    Dim Rng As Range
    Dim c As Range
    Dim x As Long
    Set Rng = Range("B11:B15")
    For Each c In Rng
        If c.Font.ColorIndex = 1 Then Exit Sub
    Next c
    For Each c In Rng
        x = Application.Rank(c.Value, Rng)
        Select Case x
            Case 1: c.Font.ColorIndex = 3
            Case 2: c.Font.ColorIndex = 7
            Case 3: c.Font.ColorIndex = 10
            Case 4: c.Font.ColorIndex = 5
            Case 5: c.Font.ColorIndex = 9
        End Select
    Next c
End Sub
 
Upvote 0
Thanks Andrew, however, it is not giving me the result I need. The picture below may help me to explain things for you.

B11:G15 is a dynamic range (it will change when a different item from the combo box is selected - which has a target cell of I9 in this example - In reality it is R17)

I have 2 buttons, one to turn colours on, and the other to turn colours off.

When colours on is chosen, the text in the cells in the range change colour.

When a new item from the combo box is selected, however, the colours don't update automatically. I have to click on the colours on button.

If the code you gave me will help with this, then I must not be using it correctly.

Thanks for your patience:)
Book2.xls
ABCDEFGHIJ
7
8Colourson(Button)
9ComboboxColoursoff(Button)3
10
114456765644
1288567886784
1356344479587
146677569867
1566778677566
16
Sheet3

This message was edited by The Idea Dude on 2002-09-12 02:06
 
Upvote 0
Hi,

In your previous post you wanted the code to run if the value in cell R17 changes. I see that I used cell A17. So in your sheet change event procedure the first line should be:

If Target.Address <> "$R$17" Then Exit Sub

I see in my code that it looks like "$A" (Board translation problem). It should be DollarADollar17 and it should be amended to DollarRDollar17, where Dollar = $.

If cell I9 is the changing cell (like in your example) then it should be DollarIDollar9.

Hope that works.
 
Upvote 0
Still no luck Andrew, I changed that and I still have to click the colours on button to have the colours update when I select a different item from the combo box.

The code for my buttons is in module 1

I have put the code you have just given me in module 1 at the top, and I have also tried it in the sheet where the table is, still no luck.

When I click on the play button in VBA, a box pops up, I select colours, and then run and it works. It just doesn't work automatically when I change an item in the combo box :)

Thanks again for your patience, I appreciate it.
 
Upvote 0
On 2002-09-12 01:59, Andrew Poulsom wrote:
Post your code.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$R$17" Then Exit Sub
Application.EnableEvents = False
Call Colours
Application.EnableEvents = True
End Sub


Sub Colours()
Dim Rng As Range
Dim c As Range
Dim x As Long
Set Rng = Range("B11:B15")
For Each c In Rng
x = Application.Rank(c.Value, Rng)
Select Case x
Case 1: c.Font.ColorIndex = 3
Case 2: c.Font.ColorIndex = 7
Case 3: c.Font.ColorIndex = 10
Case 4: c.Font.ColorIndex = 5
Case 5: c.Font.ColorIndex = 9
End Select
Next c

And then it continues for the diff colums in the table until

Set Rng = Range("G11:G15")
For Each c In Rng
x = Application.Rank(c.Value, Rng)
Select Case x
Case 1: c.Font.ColorIndex = 3
Case 2: c.Font.ColorIndex = 7
Case 3: c.Font.ColorIndex = 10
Case 4: c.Font.ColorIndex = 5
Case 5: c.Font.ColorIndex = 9
End Select
Next c

End Sub


And for the colours of button, it is the same (without the top little bit - private sub), except all colours are 1.

Thanks
 
Upvote 0
Yep, I just re-tested it and it does change when I select a different option from the drop down box
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,255
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top