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
.TintAndShade = 0
.PatternTintAndShade = 0
Else
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
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
Select Case r.Address
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
.TintAndShade = 0
.PatternTintAndShade = 0
Else
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
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.