Automatically move an entire row of expired item from one sheet to another sheet

Posts
1
Registration date
Saturday December 29, 2018
Last seen
December 29, 2018
-
Hi,

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
I
LOCATION
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

End With

End Sub

See more 

Your reply

1 reply

Best answer
Posts
264
Registration date
Wednesday November 28, 2018
Status
Verified expert
Last seen
January 22, 2019
403
1
Thank you
Hey,

If you want to move an entire row from one worksheet to another in the same workbook, here is the answer on this link.

In case there is any other issue, feel free to write!

Thanks 
Ratnendra Ashok

Community Manager - CCM.net

Respond to Ratnendra Ashok