Change cell color to adjacent cells color.

[imback2nite]

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.

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

 

[MARK858]

You're welcome.

 

[imback2nite]

Hello. I was having a little trouble with the code as it was. When I input information into an adjacent cell, to the right, it would return to the original color. I tried this and it works but was wondering if it's the best way or a more elegant method? Thank you.

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.Resize(, 2).Interior.ColorIndex = xlNone
            Cell.Resize(, 2).Font.Bold = False
        ElseIf UCase(Cell.Value) Like UCase(Sheet4.Range("B9") & "*") Then
            Cell.Resize(, 2).Interior.ColorIndex = 6
        ElseIf UCase(ActiveCell.Offset(0, -1).Value) Like UCase(Sheet4.Range("B9") & "*") Then
            Cell.Interior.ColorIndex = 6
        ElseIf UCase(Cell.Value) Like UCase(Sheet4.Range("C9") & "*") Then
            Cell.Resize(, 2).Interior.ColorIndex = 8
        ElseIf UCase(ActiveCell.Offset(0, -1).Value) Like UCase(Sheet4.Range("C9") & "*") Then
            Cell.Interior.ColorIndex = 8
        ElseIf UCase(Cell.Value) Like UCase(Sheet4.Range("D9") & "*") Then
            Cell.Resize(, 2).Interior.ColorIndex = 26
        ElseIf UCase(ActiveCell.Offset(0, -1).Value) Like UCase(Sheet4.Range("D9") & "*") Then
            Cell.Interior.ColorIndex = 26
        ElseIf UCase(Cell.Value) Like UCase(Sheet4.Range("E9") & "*") Then
            Cell.Resize(, 2).Interior.ColorIndex = 4
        ElseIf UCase(ActiveCell.Offset(0, -1).Value) Like UCase(Sheet4.Range("E9") & "*") Then
            Cell.Interior.ColorIndex = 4
        ElseIf UCase(Cell.Value) Like UCase(Sheet4.Range("F9") & "*") Then
            Cell.Resize(, 2).Interior.ColorIndex = 46
        ElseIf UCase(ActiveCell.Offset(0, -1).Value) Like UCase(Sheet4.Range("F9") & "*") Then
            Cell.Interior.ColorIndex = 46
         ElseIf UCase(Cell.Value) Like UCase(Sheet4.Range("G9") & "*") Then
            Cell.Resize(, 2).Interior.ColorIndex = 40
        ElseIf UCase(ActiveCell.Offset(0, -1).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