PDA

View Full Version : Need some help pls. How to color cell A if cell B is an even number

Ted608
04-20-2015, 02:18 AM
Hi,

I would like to color cell A (in VBA) if the value in cell B is an even number like: 2, 4, 6,....

Thank you very much for any help or suggestions.

Ted

jonh
04-20-2015, 03:23 AM
Hi!

Copy this into the sheet's module

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, e As Boolean

For Each r In Target.Cells
e = False
With r
If .Column = 2 Then
If Len(.Text) <> 0 Then
If IsNumeric(.Text) Then
e = .Text Mod 2 = 0
End If
End If
With .Offset(0, -1).Interior
If e Then
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
Else
.Pattern = xlNone
End If
End With
End If
End With
Next
End Sub

Ted608
04-20-2015, 08:16 AM
Hi Jonh,

Thank you for your quick response!

How would I change the code to make the code just check these cells only:

If cell W33=Even, then Color the Cell J33=Red
If cell W36=Even, then Color the Cell J36=Red
If cell W39=Even, then Color the Cell J39=Red
If cell W42=Even, then Color the Cell J42=Red

Again, thanks very much for your much needed help, Jonh.

Ted

jonh
04-20-2015, 08:47 AM
No problem.

Function GetTGT(r As Range) As Range
Case "\$W\$33": Set GetTGT = Range("\$J\$33")
Case "\$W\$36": Set GetTGT = Range("\$J\$36")
Case "\$W\$39": Set GetTGT = Range("\$J\$39")
Case "\$W\$42": Set GetTGT = Range("\$J\$42")
End Select
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, e As Boolean
Dim tgt As Range
For Each r In Target.Cells
e = False
With r
Set tgt = GetTGT(r)
If Not tgt Is Nothing Then
If Len(.Text) <> 0 Then
If IsNumeric(.Text) Then
e = .Text Mod 2 = 0
End If
End If
With tgt.Interior
If e Then
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
Else
.Pattern = xlNone
End If
End With
End If
End With
Next
End Sub

Ted608
04-20-2015, 09:30 AM
Hi Jonh,

Much appreciation for your quick response!

I will try the code and modify it a tiny bit at a time for what I need but it will take me quite a bit of time to digest all this because programming is quite new to me and there are a few number of concepts to be grasped here but again thank you for your generous help!

Ted.