VBA Conditional Formatting A GROUP of Cells

D

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
 
B

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

D_Williams

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

Simon Lloyd

D_Williams;295127 said:
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)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top