Auto Colour of Cells

WILFY06

Board Regular
Joined
Oct 13, 2006
Messages
99
Dear All....

I know that this is possible as have seen it before, but using a defined table as ColourKey i want to create a macro that looks at the spreadsheet in given cell area, and then colours cells according to their names from the colourkey, any help would be appreciated... this is how far i've got prob wrong.

Sub ColourKey()
' Auto Colours Cells Using for Rota System and Holiday Maps

Dim ColourKey as

End Sub

Yeah i know not far eh!! lol

Kind Regards,
David
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.

WILFY06

Board Regular
Joined
Oct 13, 2006
Messages
99
will be names so David is assigned red as in the table and Susan is Blue, something like that? don't know if text has to be in the colour or next to it?
Thanks
David
 

WILFY06

Board Regular
Joined
Oct 13, 2006
Messages
99
This one seemed to have tricked a few people, so contacted guy i know and found answer!! all credit to him so take a bow STUART DIXON..

'Written by Stuart Dixon
Sub ColourThisIn()
Dim TextArray() As String
Dim ColourArray() As Long
Dim ArrayCount As Integer
Dim MaxRows As Long
Dim MaxCols As Long
Dim RowCount As Long
Dim ColCount As Long

'pick up the colours from the spreadsheet
Range("ColourKey").Select
ActiveCell.Offset(1, 0).Select
ArrayCount = 0
While ActiveCell.Value <> ""
ReDim Preserve TextArray(ArrayCount)
ReDim Preserve ColourArray(ArrayCount)
TextArray(ArrayCount) = ActiveCell.Value
ColourArray(ArrayCount) = ActiveCell.Interior.ColorIndex
ActiveCell.Offset(1, 0).Select
ArrayCount = ArrayCount + 1
Wend
'go through each cell & change the colour is applicable
ActiveCell.SpecialCells(xlCellTypeLastCell).Select
MaxRows = ActiveCell.Row
MaxCols = ActiveCell.Column
For RowCount = 1 To MaxRows
For ColCount = 1 To MaxCols
For ArrayCount = LBound(TextArray) To UBound(TextArray)
If Cells(RowCount, ColCount).Value = TextArray(ArrayCount) Then
With Cells(RowCount, ColCount).Interior
.ColorIndex = ColourArray(ArrayCount)
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
End If
Next ArrayCount
Next ColCount
Next RowCount
Range("ColourKey").Select
End Sub
 

Forum statistics

Threads
1,143,674
Messages
5,720,234
Members
422,271
Latest member
xbaca

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