Change cell color to adjacent cells color.

imback2nite

Board Regular
Joined
Oct 30, 2004
Messages
203
Office Version
  1. 2003 or older
Platform
  1. 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
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
I'm not able to use conditional formatting as I'm using Excel 2003.

Why? 2003 had conditional formats... see link below
http://www.contextures.com/xlCondFormat02_2003.html

As for your code for example...

Code:
    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


change to something like...

Code:
    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
 
Upvote 0
Mark858, What is the function of Resize (,2) over here. I am a VBA novice. So, just wanted to gain some knowledge looking at this code.
 
Upvote 0
It expands the range.. Resize(, 2) changes the single cell to a range 2 columns wide, Resize(4) or more correctly Resize(4,1) would expand the single cell range by 4 rows so

Code:
Range("A1").Resize(,4).Select

would select Range("A1:D1")

and

Code:
Range("A1").Resize(4).Select

would select Range("A1:A4")

and

Code:
Range("A1").Resize(4,4).Select

would select Range("A1:D4")
 
Upvote 0
Thanks for that amazing info Mark. Allow me to ask one more question. Is Resize to VBA the same; what offset is to excel formula ?
 
Upvote 0
No Offset in VBA is equivalent to OFFSET in formula.
 
Upvote 0
Ok Mark. Thanks a lot once again.

Just to make sure that you understand, run the 2 macro's below and then you will see the difference.

Code:
Sub ResizeMe()
Range("A1:D1").Interior.ColorIndex = xlNone
Range("A1").Resize(, 4).Interior.ColorIndex = 6
End Sub

Code:
Sub OffsetMe()
Range("A1:D1").Interior.ColorIndex = xlNone
Range("A1").Offset(, 4).Interior.ColorIndex = 6
End Sub
 
Upvote 0
Ohh Great examples to make me remember the differences. Objects/concepts has been stored in memory for further usage. :)
 
Upvote 0
Mark! That's amazing. I didn't know there was a 'Resize' And with that example, I have many uses! Thank you so much!
 
Upvote 0

Forum statistics

Threads
1,213,514
Messages
6,114,078
Members
448,547
Latest member
arndtea

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
Back
Top