VBA Conditional Formatting A GROUP of Cells

[D_Williams]

Hi There!!

I really need help with this. I'm creating a spreadsheet and I'm trying to
do conditional formatting in VBA. I want it so that if I type a particular
word in one cell that it automatically colors that cell, along with two of
the adjacent cells on each side. For example, if you type "Auto" in cell C1,
it colors cells A1-E1. This is the code I'm using right now but it only
colors the cell in which I type the word in. Any help would be appreciated!!


Private Sub Worksheet_Change(ByVal Target As Range)

Dim Isect As Range

Set Isect = Application.Intersect(Range("A1:M200"), Target)
If Isect Is Nothing Then
'Do nothing
Else
Select Case Target.Value
Case "Auto"
Target.Interior.ColorIndex = 39
Case "Gas"
Target.Interior.ColorIndex = 40
Case "Income"
Target.Interior.ColorIndex = 4
Case "Rent"
Target.Interior.ColorIndex = 42
End Select

End If

End Sub

 

[Bernie Deitrick]

D,

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
'Apply to C:K only to give two column "Border"
If Target.Column < 3 Or Target.Column > 11 Then Exit Sub
With Target.Offset(0, -2).Resize(1, 5)
Select Case Target.Value
Case "Auto"
.Interior.ColorIndex = 39
Case "Gas"
.Interior.ColorIndex = 40
Case "Income"
.Interior.ColorIndex = 4
Case "Rent"
.Interior.ColorIndex = 42
End Select
End With
End Sub

HTH,
Bernie
MS Excel MVP

 

[D_Williams]

Oh my gosh, that worked great!! Thanks, I'm new to VBA. That worked
perfectly. Thanks again!

 

[Simon Lloyd]

Hi There!!

I really need help with this. I'm creating a spreadsheet and I'm trying
to
do conditional formatting in VBA. I want it so that if I type a
particular
word in one cell that it automatically colors that cell, along with two
of
the adjacent cells on each side. For example, if you type "Auto" in
cell C1,
it colors cells A1-E1. This is the code I'm using right now but it only
colors the cell in which I type the word in. Any help would be
appreciated!!


Private Sub Worksheet_Change(ByVal Target As Range)

Dim Isect As Range

Set Isect = Application.Intersect(Range("A1:M200"), Target)
If Isect Is Nothing Then
'Do nothing
Else
Select Case Target.Value
Case "Auto"
Target.Interior.ColorIndex = 39
Case "Gas"
Target.Interior.ColorIndex = 40
Case "Income"
Target.Interior.ColorIndex = 4
Case "Rent"
Target.Interior.ColorIndex = 42
End Select

End If

End SubIt's done like this, however, i have added On Error Resume Next as if

you choose a cell column A it will try to colour a cell that doesn't
exist:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Isect As Range
Set Isect = Application.Intersect(Range("A1:M200"), Target)
If Isect Is Nothing Then
'Do nothing
Else
On Error Resume Next
Select Case Target.Value
Case "Auto"
Target.Interior.ColorIndex = 39
Target.Offset(0, -1).Interior.ColorIndex = 39
Target.Offset(0, 1).Interior.ColorIndex = 39
Case "Gas"
Target.Interior.ColorIndex = 40
Target.Offset(0, -1).Interior.ColorIndex = 40
Target.Offset(0, 1).Interior.ColorIndex = 40
Case "Income"
Target.Interior.ColorIndex = 4
Target.Offset(0, -1).Interior.ColorIndex = 4
Target.Offset(0, 1).Interior.ColorIndex = 4
Case "Rent"
Target.Interior.ColorIndex = 42
Target.Offset(0, -1).Interior.ColorIndex = 42
Target.Offset(0, 1).Interior.ColorIndex = 42
End Select
End If
End Sub


--
Simon Lloyd

Regards,
Simon Lloyd
'The Code Cage' (http://www.thecodecage.com)