Expirity Date Compare

[Buskopan]

Hello Again,

I want macro to check the expiry dates.

Range (H2:H12) has the expirity dates of listed drugs. I want code to check the expirity dates and if it is less than 60 days left highlight the date and drugname (which is in B column) in bold and green. If it is less than 30 days left till expoiration date, highlight bold and red.

Please help.
Thank you in advance.

 

[Andrew Poulsom]

You can use a Conditional Formatting formula like:

=(H2-60) < TODAY()

 

[NeonRedSharpie]

You don't need a macro, you can just use conditional formatting. But, because you asked for a macro:

Sub expiryColor()

    For Each iCell In Range("H2:H12")
        
    With iCell
        Select Case .value
            Case Is < Date + 30
                Debug.Print Date + 30
                Debug.Print iCell.value
                .Interior.Color = vbRed
                .Offset(0, -6).Interior.Color = vbRed
                .Font.Bold = True
                .Offset(0, -6).Font.Bold = True
            Case Is < Date + 60
                .Interior.Color = vbGreen
                .Offset(0, -6).Interior.Color = vbGreen
                .Font.Bold = True
                .Offset(0, -6).Font.Bold = True
            Case Else
                .Interior.Color = vbWhite
                .Offset(0, -6).Interior.Color = vbWhite
                .Font.Bold = False
                .Offset(0, -6).Font.Bold = False
        End Select
    End With
    Next iCell
End Sub

 

[ITWare2008]

Hi Buskopan,

use conditional formatting and specify a custom formula using the following condition

=$g4<=60 -> apply bold and green text

another condition
=$g4<=30 -> apply bold and red text

You have to select every row to each you want to apply the condition.

Hope this help.

Vândalo

 

[Buskopan]

Of course I can use conditional formatting but I need macro as I will do something else with that Not sure yet what exactly

Thank you for prompt replies. Will try all.

 

[Buskopan]

Thank you, NeonRedSharpie . That is exactly what I need. Some cells in range H2:H12 are empty. How I can bypass them to not highlight in red.

 

[Buskopan]

Hi Buskopan,

use conditional formatting and specify a custom formula using the following condition

=$g4<=60 -> apply bold and green text

another condition
=$g4<=30 -> apply bold and red text

You have to select every row to each you want to apply the condition.

Hope this help.

Vândalo

Hello. For some reason this returns with mistake in formula. What $g4 stands for ? Dates in cells are in MM.YYYY format.

 

[Buskopan]

You don't need a macro, you can just use conditional formatting. But, because you asked for a macro:

Sub expiryColor()

    For Each iCell In Range("H2:H12")
        
    With iCell
        Select Case .value
            Case Is < Date + 30
                Debug.Print Date + 30
                Debug.Print iCell.value
                .Interior.Color = vbRed
                .Offset(0, -6).Interior.Color = vbRed
                .Font.Bold = True
                .Offset(0, -6).Font.Bold = True
            Case Is < Date + 60
                .Interior.Color = vbGreen
                .Offset(0, -6).Interior.Color = vbGreen
                .Font.Bold = True
                .Offset(0, -6).Font.Bold = True
            Case Else
                .Interior.Color = vbWhite
                .Offset(0, -6).Interior.Color = vbWhite
                .Font.Bold = False
                .Offset(0, -6).Font.Bold = False
        End Select
    End With
    Next iCell
End Sub

It is works as supposed. But can;t understand why it highlights the empty cells in red. Some cells are missing the dates as I have mentioned in above post.

That part I beleive should ignore the empty cells as well as all other cells above 60 days range, But for some reason it highlights the empty ones as well

Case Else
                .Interior.Color = vbWhite
                .Offset(0, -6).Interior.Color = vbWhite
                .Font.Bold = False
                .Offset(0, -6).Font.Bold = False

 

[NeonRedSharpie]

Sub expiryColor()

    For Each iCell In Range("H2:H12")
        
    With iCell
        Select Case .value
            Case ""
                .Interior.Color = vbWhite
                .Offset(0, -6).Interior.Color = vbWhite
                .Font.Bold = False
                .Offset(0, -6).Font.Bold = False
            Case Is < Date + 30
                Debug.Print Date + 30
                Debug.Print iCell.value
                .Interior.Color = vbRed
                .Offset(0, -6).Interior.Color = vbRed
                .Font.Bold = True
                .Offset(0, -6).Font.Bold = True
            Case Is < Date + 60
                .Interior.Color = vbGreen
                .Offset(0, -6).Interior.Color = vbGreen
                .Font.Bold = True
                .Offset(0, -6).Font.Bold = True
            Case Else
                .Interior.Color = vbWhite
                .Offset(0, -6).Interior.Color = vbWhite
                .Font.Bold = False
                .Offset(0, -6).Font.Bold = False
        End Select
    End With
    Next iCell
End Sub

Try that.

 

[Buskopan]

Works ! Thank you!