Tracking Expiration Dates

[katiapro93]

Hello everyone, it has been a while, and I am afraid my mind is blank. I need ideas on the best way to set up an Excel worksheet that tracks expiration dates on products that we receive. I have a worksheet that I throw in the content of all POs and the receiving information, along with the current inventory. The issue is that on that sheet, items can and should be duplicated as we reorder them. Also, everyday I lookup the current inventory and thus, it is not a steady number. So my worksheet looks something like:

item#, Description, Qty received, Expiration date, Inventory upon arrival, current inventory

I was thinking, if I can have one sheet with just everything thrown in and then each item have its own ledger, problem with that is that we have over 2000 items and even doing a pivot, I would have to do 1 sheet for each item. Too long.

Any ideas?

 

[ranman256]

reset the constants for your fields :
kCOLdate : the col Letter with the date to look at
kCOLresult :the col letter where to write the result

Sub FindExpiredDates()
Dim iRows As Long, iFldNum As Long, iResultOFF As Long
Dim vExpDate
Const kCOLresult = "K"
Const kCOLdate = "G"
iFldNum = Range(kCOLresult & "1").Column
iResultOFF = iFldNum - Range(kCOLdate & "1").Column
vExpDate = InputBox("Enter Expire Date", "Find Expired Items")
If vExpDate = "" Then Exit Sub
vExpDate = CDate(vExpDate)
'clear results col.
Columns("K").ClearContents
Range("K1").Value = "RESULTS"
  'get #rows
Range("A2").Select
iRows = ActiveSheet.UsedRange.Rows.Count
'MsgBox iRows
Range(kCOLdate & "2").Select
While ActiveCell.Row <= iRows
If ActiveCell.Value > vExpDate Then ActiveCell.Offset(0, iResultOFF).Value = vExpDate

ActiveCell.Offset(1, 0).Select 'next row
Wend
 'filter results
ActiveSheet.Range("A1").AutoFilter Field:=iFldNum, Criteria1:=vExpDate
End Sub