Solved: ayto formatting

[paddy69]

Desperately seeking help.

I need a macro that automatically selects projects in a column to give them a (random) color (cell fill). At the same time I need to change the of color all cells in the same row that contain any value. The color needs to be identical to the project color. The empty cells need to stay white.

I have added a sample with just a couple of projects and I manually changed the color of the cells. Is there anyone that can help me with a macro?

Thanks!!!!

[Bob Phillips]

Beware, it looks horrible



Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long, j As Long
Dim iLastRow As Long
Dim iRow As Long
Dim iCI As Long


With ActiveSheet

iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 2 To iLastRow
On Error Resume Next
iRow = Application.Match(.Cells(i, TEST_COLUMN).Value, _
.Cells(1, TEST_COLUMN).Resize(i - 1), 0)
On Error GoTo 0
If iRow > 0 Then
iCI = .Cells(iRow, TEST_COLUMN).Interior.ColorIndex
Else
iCI = Int(Rnd() * 42 + 1)
End If
.Cells(i, TEST_COLUMN).Interior.ColorIndex = iCI
For j = 2 To .Cells(i, .Columns.Count).End(xlToLeft).Column
If .Cells(i, j).Value <> "" Then
.Cells(i, j).Interior.ColorIndex = iCI
End If
Next j
Next i

End With
End Sub

[mdmackillop]

The random colouring is questionable!
Option Explicit
Sub RandCol()
Dim Rng As Range, Col As Long, Cel As Range, c As Range, FirstAddress As String
Set Rng = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
Col = Int(Rnd * 10)
For Each Cel In Rng
If Cel.Interior.ColorIndex = xlNone Then
Col = Col + 1
With Rng
Set c = .Find(Cel, LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
c.Interior.ColorIndex = Col
c.Offset(, 3).Resize(1, 252).SpecialCells(xlTextValues).Interior.ColorIndex = Col
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
End If
Next
End Sub

[Bob Phillips]

I did say it looks horrible.