imback2nite
Board Regular
- Joined
- Oct 30, 2004
- Messages
- 203
- Office Version
- 2003 or older
- Platform
- Windows
I'm using the code below provided by one of the gurus in this forum. I do have one question. Is there a way to modify this to have the adjacent cell turn the same color? For example, if Cell.Interior.ColorIndex = 6 I would like the cell to the right to also turn ColorIndex = 6. Or offset (0,1) I'm not able to use conditional formatting as I'm using Excel 2003. Help on this is appreciated.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
Dim Rng1 As Range
If Target.Address = "$D$1" Then
ActiveSheet.Name = Left(Target.Value, 35)
Exit Sub
End If
On Error Resume Next
Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1)
On Error GoTo 0
If Rng1 Is Nothing Then
Set Rng1 = Range(Target.Address)
Else
Set Rng1 = Union(Range(Target.Address), Rng1)
End If
For Each Cell In Rng1
If Cell.Value = vbNullString Then
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
ElseIf UCase(Cell.Value) Like UCase(Sheet4.Range("B9") & "*") Then
Cell.Interior.ColorIndex = 6
ElseIf UCase(Cell.Value) Like UCase(Sheet4.Range("C9") & "*") Then
Cell.Interior.ColorIndex = 8
ElseIf UCase(Cell.Value) Like UCase(Sheet4.Range("D9") & "*") Then
Cell.Interior.ColorIndex = 26
ElseIf UCase(Cell.Value) Like UCase(Sheet4.Range("E9") & "*") Then
Cell.Interior.ColorIndex = 4
ElseIf UCase(Cell.Value) Like UCase(Sheet4.Range("F9") & "*") Then
Cell.Interior.ColorIndex = 46
ElseIf UCase(Cell.Value) Like UCase(Sheet4.Range("G9") & "*") Then
Cell.Interior.ColorIndex = 40
Else
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
End If
Next
End Sub