Coloring a group of cells?

M

Michael

Hi,

I am using the following piece of VBA code to color cells in column
range, M10 to M59, uniquly based on their values.

Set rngArea = ActiveSheet.Range("M10:M59")

intColor = 2
On Error Resume Next
For Each rngCellA In rngArea

If rngCellA.Value <> "" Then
Err.Clear
colValue.Add rngCellA.Value, "MB" & rngCellA.Value
If Err = 0 Then
intColor = intColor + 1
For Each rngCellB In rngArea
If rngCellB.Value = rngCellA.Value Then
rngCellB.Interior.ColorIndex = intColor
End If
Next rngCellB
End If
Else
rngCellA.Interior.ColorIndex = 2

End If
Next rngCellA

Q:
Say, if cell M10 color is red, then I want cells C10:F10 to be red
automatically. If cell M11 color is green, then I want cells C11:F11
to be green, and so on.

What should I add to the following code to force him to do so?

Thanks,
Mike
 
F

Frank Kabel

Hi
add after the line
rngCellB.Interior.ColorIndex = intColor

the following line
Range(cells(rngCellB.row,"C"),cells(rngCellB.row,"F")).interior.colorin
dex=intcolor
 
J

JE McGimpsey

One way:

Public Sub ColorCells()
Dim rngArea As Range
Dim rngCell As Range
Dim rngCells As Range
Dim rngFound As Range
Dim intColor As Integer

Application.ScreenUpdating = False
intColor = 3
Set rngArea = Range("M10:M59")
With rngArea
.Interior.ColorIndex = xlColorIndexNone
For Each rngCell In .Cells
With rngCell
If .Interior.ColorIndex = xlColorIndexNone Then
Set rngCells = .Cells
Set rngFound = rngArea.Find( _
What:=.Value, _
After:=.Cells, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
MatchCase:=False)
Do While rngFound.Address <> .Address
Set rngCells = Union(rngCells, rngFound)
Set rngFound = rngArea.FindNext( _
After:=rngFound)
Loop
rngCells.Interior.ColorIndex = intColor
intColor = intColor + 1
End If
.Offset(0, -10).Resize(1, 4).Interior.ColorIndex = _
.Interior.ColorIndex
End With
Next rngCell
End With
Application.ScreenUpdating = True
End Sub
 
Top