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

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

[snb]

You are right:

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