VBA Code to highlight Odd and Even numbers

[Kalpesh]

I am trying to write a VBA Function code to highlight Odd and Even numbers. But not having much luck. Can anyone help me, please?


I would like to use following condition to highlight a cell:


=AND(ISODD(A1), A1<24) for Low-Odds
=AND(ISODD(A1), A1>24) for Low-Evens
=AND(ISEVEN(A1), A1<23) for High-Odds
=AND(ISEVEN(A1), A1>23) for High-Evens

[paulked]

Hi again!

Try this in the sheet module (right-click on the sheet tab and 'View Code'):



Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1, B2, C3, D4:D20")) Is Nothing Then
Target.Interior.Color = xlNone
If Not IsNumeric(Target) Then Exit Sub
If Target < 24 And IsOd(Target) Then
Target.Interior.Color = vbRed
ElseIf Target < 24 And Target > 0 And Not IsOd(Target) Then
Target.Interior.Color = vbYellow
ElseIf Target > 23 And IsOd(Target) Then
Target.Interior.Color = vbGreen
ElseIf Target > 23 And Not IsOd(Target) Then
Target.Interior.Color = vbBlue
End If
End If
End Sub


Function IsOd(x) As Boolean
IsOd = WorksheetFunction.IsOdd(x)
End Function

[Kalpesh]

Sorry to be a pain, but after I copied the code how do I use it? Thank you for your help.

[paulked]

If you've put the code in the correct place, it will run in the background. Any time you enter a number in any of cells in red:


If Not Intersect(Target, Range("A1, B2, C3, D4:D20")) Is Nothing Then then the background will change colour.

[Kalpesh]

I have a spreadsheet with 2000 rows and 10 columns with numbers in it. Can I still use this code for it?

[paulked]

You can highlight any cells, just change the ranges in the code (and colours if you wish!). eg (Target, Range("A:J")) will change any cell in the first 10 columns after the value has been changed.

[Kalpesh]

What if I have existing value in each cell?

[paulked]

What range are the cells in? I can probably write a routine to colour them.

[paulked]

I've just realised that this thread should be moved to the proper forum, I'll see if I can ask one of the moderators to move it.

[Kalpesh]

What range are the cells in? I can probably write a routine to colour them.
They are in B3:I518

[paulked]

I've just realised that this thread should be moved to the proper forum, I'll see if I can ask one of the moderators to move it.

[paulked]

Copy this code into the sheet module and run it (with the courser anywhere in the routine either press F5 or click the little green arrow in the VBE toolbar). It will take a few seconds to run but should colour all your cells.



Sub ColMe()
Dim rng As Range, cell As Range
Set rng = Range("B3:I518")
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
For Each cell In rng
If IsNumeric(cell) And cell.Value2 <> 0 Then
cell.Interior.Color = xlNone
If cell < 24 And IsOd(cell) Then
cell.Interior.Color = vbRed
ElseIf cell < 24 And cell > 0 And Not IsOd(cell) Then
cell.Interior.Color = vbYellow
ElseIf cell > 23 And IsOd(cell) Then
cell.Interior.Color = vbGreen
ElseIf cell > 23 And Not IsOd(cell) Then
cell.Interior.Color = vbBlue
End If
End If
Next
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

[macropod]

​Kalpesh: Kindly post your threads in the appropriate forum; this thread's subject mater is most definitely not 'Site & Forum Related' - it clearly concerns Excel. Thread moved.

[snb]

Sub M_snb()
For Each it In Range("B3:I518")
If it <> "" Then it.Interior.Color = Choose((it Mod 2) - 2 * (it < 24) + 1, vbRed, vbYellow, vbGreen, vbBlue)
Next
End Sub
or

Sub M_snb()
sn-array(vbRed, vbYellow, vbGreen, vbBlue)

For Each it In Range("B3:I518")
If it <> "" Then it.Interior.Color = sn((it Mod 2) - 2 * (it < 24))
Next
End Sub

[Kalpesh]

Thank you for your help. It works like a magic.

[paulked]

@keplash :thumb

snb, logical poetry! Had to change the "-" for "=" in your 2nd routine :whistle:

[snb]

You are right::banghead:


Sub M_snb()
sn=array(vbRed, vbYellow, vbGreen, vbBlue)

For Each it In Range("B3:I518")
If it <> "" Then it.Interior.Color = sn((it Mod 2) - 2 * (it < 24))
Next
End Sub

[snb]

Can be done simpler:


Sub M_snb()
For Each it In Range("A1:B4")
If (it <> "") * IsNumeric(it) Then it.Interior.Color = 255 ^ ((it Mod 2) - 2 * (it < 24))
Next
End Sub

[Tom Jones]

@snb

Yes!!! I really wanted to draw your attention :) :) as it was a simpler option :) :) :)