I have a problem with the code below. I am a store officer in the firm I am currently with, and monitory of expiring date of a product is part of my daily routine.
I have been able to use excel (if function and conditional formatting) to create an automated expiring alert that gives me alert from eight month to the expiring date of the product.
Furthermore, I want to programme the alert I have created to automatically move entire row of every expired item from one sheet to another sheet that's from sheet1 (alert) to sheet3 (expired) without manually cutting and paste from one sheet to another each time an item get expired.
I tried these codes but I can't seem to have my way around it.
I am just typing below how the format on the sheet 1(Alert) looks like and also uploaded a picture of the sheet.
I am very grateful for your help!
A B C D
RECEIVED DATE RECEIVED FROM MEDICINES BATCH NUMBER
E F G H
QUANTITY RECEIVED EXPIRING DATE DAYS LEFT STATUS
December 5, 2018 PARA 25mg PARA 25MG 10 100 Monday, October 1, 2018 -89 EXPIRED
Sub TransferExpired() Dim h As Range, TransferRange As Range, DataRange As Range Dim DestRange As Range Dim Lr As Long Dim iCount As Long With ThisWorkbook With .Sheets("ALERT") Lr = Sheets("ALERT").Range("A" & Rows.Count).End(xlUp).Row Set DataRange = ALERT.Range("A3:A" & Lr + 1) End With
With .Sheets("EXPIRED") Lr = Sheets("EXPIRED").Range("A" & Rows.Count).End(xlUp).Row + 1 Set DataRange = EXPIRED.Range("A2:A" & Lr + 1) DataRange.EntireRow.Hidden = False
For Each h In DataRange.Cells If IsDate("Monday,October1,2018") Then If ("Monday,October1,2018") < Date Then If TransferRange Is Nothing Then Set TransferRange = h Else Set TransferRange = Union("A3:A17", h) End If iCount = iCount + 1 End If End If Next h If Not TransferRange Is Nothing Then With TransferRange.EntireRow .Copy DestRange .Delete End With End If
MsgBox iCount & " Expired Records Transferred", 50, "EXPIRED" End With