VBA code

The Idea Dude

Well-known Member
Joined
Aug 15, 2002
Messages
589
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
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

ChrisUK

Well-known Member
Joined
Sep 3, 2002
Messages
675
Ok, not the neatest idea but one you can work with. This works nicely with values in the cells upto 255, over that and the VB errors as the colour 256 is not available so you'd need to do some maths (divide the value by 255) if you wanted to go this way. I recon you could put the colour bit in a loop as well to make the macro more compact.

Have you also discounted conditional formating ? This would only work for 4 cells (one background) would always be white)

anyway,s hope this helps you

Range("A1:A5").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select
With Selection.Interior
.ColorIndex = Range("A1").Value
.Pattern = xlSolid
End With
Range("A2").Select
With Selection.Interior
.ColorIndex = Range("A2").Value
.Pattern = xlSolid
End With
Range("A3").Select
With Selection.Interior
.ColorIndex = Range("A3").Value
.Pattern = xlSolid
End With
Range("A4").Select
With Selection.Interior
.ColorIndex = Range("A4").Value
.Pattern = xlSolid
End With
Range("A5").Select
With Selection.Interior
.ColorIndex = Range("A5").Value
.Pattern = xlSolid
End With
 

The Idea Dude

Well-known Member
Joined
Aug 15, 2002
Messages
589
Thanks for the reply Chris. I am unable to change the location of the data (sort) because the cells are results of formulas.

Any other ideas?
 

Iain Lewis

Board Regular
Joined
Apr 15, 2002
Messages
217
How about this code :

Dim myCount As Integer
Dim myRan As String

Sub aaa()
myCount = 1
Do Until myCount = 6
myRan = WorksheetFunction.Large(Range("A1:A5"), myCount)
Range("A1:A5").Find(myRan, LookAt:=xlWhole).Select
Selection.Interior.ColorIndex = myCount
myCount = myCount + 1
Loop
End Sub

At the moment it doesn't allow you to specify the colour, but I'm sure it can be changed if reqiured.

BTW - it ignores duplicated numbers, so may need more work there.

Iain
This message was edited by Iain Lewis on 2002-09-11 04:15
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092

ADVERTISEMENT

Try this:

Code:
Sub Test()
    Dim Rng As Range
    Dim c As Range
    Dim x As Long
    Set Rng = Range("A1:A5")
    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 = 4
            Case 3: c.Font.ColorIndex = 5
            Case 4: c.Font.ColorIndex = 6
            Case 5: c.Font.ColorIndex = 7
        End Select
    Next c
End Sub
 

ChrisUK

Well-known Member
Joined
Sep 3, 2002
Messages
675
OK, try this instead

Sub sortit()

Dim myarray(5)

'Copy cells to an array
For x = 1 To 5
myarray(x) = Cells(x, 1)
Next

'Sort the array
For x = 1 To 5
For y = 1 To x - 1
If myarray(x) < myarray(y) Then
t = myarray(x)
myarray(x) = myarray(y)
myarray(y) = t
End If
Next
Next

mcol = 15
'Colour cells
For x = 1 To 5
For y = 1 To 5
If myarray(x) = Cells(y, 1) Then
Cells(y, 1).Select
With Selection.Interior
.ColorIndex = mycol
.Pattern = xlSolid
End With
mycol = mycol + 1
Exit For
End If
Next
Next

x = 1

End Sub
 

ChrisUK

Well-known Member
Joined
Sep 3, 2002
Messages
675

ADVERTISEMENT

I like Andrews much better, I can't see any help for a "rank" method mind you!!
 

The Idea Dude

Well-known Member
Joined
Aug 15, 2002
Messages
589
Thanks every one for your help,

I tried Andrews code and it worked a charm so I didn't try the other ones, but thanks anyway! If you are keen, I have another question on the board (text wrap) that I am stuck with.

Thanks again
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
ChrisUK,

Rank is a worksheet function. I find it very useful for dynamically sorting data (eg for printing). I put in a column to rank the data, then in another column use Index, Match and Large (or Small) to reference and sort the original data.
 

Jay Petrulis

MrExcel MVP
Joined
Mar 17, 2002
Messages
2,040
On 2002-09-11 04:24, Andrew Poulsom wrote:
Try this:

Code:
Sub Test()
    Dim Rng As Range
    Dim c As Range
    Dim x As Long
    Set Rng = Range("A1:A5")
    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 = 4
            Case 3: c.Font.ColorIndex = 5
            Case 4: c.Font.ColorIndex = 6
            Case 5: c.Font.ColorIndex = 7
        End Select
    Next c
End Sub

Hi Andrew,

Nice job here. Kudos.

If the color scheme has some pattern, as in your example, it can be shortened a bit to the following...

<pre>Sub Test()
Dim Rng As Range
Dim c As Range
Dim x As Long

Set Rng = Range("A1:A5")
For Each c In Rng
x = Application.Rank(c.Value, Rng)
c.Font.ColorIndex = x + 2
Next c
End Sub</pre>
 

Forum statistics

Threads
1,144,280
Messages
5,723,470
Members
422,499
Latest member
think say

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
Top