Expirity Date Compare

Buskopan

Board Regular
Joined
Aug 4, 2014
Messages
54
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.

 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.

NeonRedSharpie

Well-known Member
Joined
Jul 14, 2014
Messages
1,678
You don't need a macro, you can just use conditional formatting. But, because you asked for a macro:

Code:
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

Board Regular
Joined
Apr 16, 2010
Messages
174
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

Board Regular
Joined
Aug 4, 2014
Messages
54

ADVERTISEMENT

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

Board Regular
Joined
Aug 4, 2014
Messages
54
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.
 
Last edited:

Buskopan

Board Regular
Joined
Aug 4, 2014
Messages
54

ADVERTISEMENT

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

Board Regular
Joined
Aug 4, 2014
Messages
54
You don't need a macro, you can just use conditional formatting. But, because you asked for a macro:

Code:
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
Code:
Case Else
                .Interior.Color = vbWhite
                .Offset(0, -6).Interior.Color = vbWhite
                .Font.Bold = False
                .Offset(0, -6).Font.Bold = False
 

NeonRedSharpie

Well-known Member
Joined
Jul 14, 2014
Messages
1,678
Code:
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.
 

Forum statistics

Threads
1,143,677
Messages
5,720,249
Members
422,272
Latest member
ginkgoVil

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top