Ideas on how to track inventory expiration dates

[David77]

NOTE* Please skip until the next line highlighted in bold if you're not interested in seeing how my setup functions. Thank you!

Hello everybody,

I am currently managing a minor inventory consisting of 101 unique goods. Currently my excel sheet looks like this:

To briefly explain the sheet:

Column F = minimum stock
Column G = current stock. I have a conditional formatting filter here that highlights the stock in a red color if it is < or = the value in the corresponding F column
Column H = Add a value to the stock. So if I enter in 5 on H3, G3 will change value to 11 and the number 5 will immediately disappear from H3 allowing me to enter a new number to add to G3
Column I = Subtract a value to the stock. So if I enter in 6 on I3, G3 will change value to 0 and the number 6 will immediately disappear from I3 allowing me to enter a new number to subtract from G3
Column J = This shows me the last time that the stock in column G was updated. It also takes account for if the value in column G was updated by adding/subtracting to it from column H and I, so it's not completely dependent on manual alterations to the numbers in column G.

Finally, the macro is shown to the right, which is given by:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, c As Range
Set r = Intersect(Target, Columns("H:I"))
If Not r Is Nothing Then
Application.EnableEvents = False
For Each c In r
With Cells(c.Row, "G")
If IsNumeric(.Value) Then
.Value = .Value + IIf(c.Column = 9, c.Value, -c.Value)
Cells(c.Row, "J").Value = Now
Cells(c.Row, "J").NumberFormat = "dd-mm-yyyy"
c.ClearContents
End If
End With
Next c
Application.EnableEvents = True
End If
End Sub

Now, to my actual question:

Currently, I receive my stock at random intervals ranging anywhere from 7-60 days. Whenever this happens I naturally have to update my stock, which works fine. However, I have some trouble with my expiration dates.

Every batch of items I receive has the same expiration date (meaning that if I order 50 items of "Material XYZ 527" all 50 of these similar materials will have the same expiration date (for example 10-12-2020)). However some times I may still have 1 or 2 of these laying around when I receive a new batch, thus meaning I can have the same item in one shelf but with different expiration dates.

I want to somehow keep track of all these expiration dates through a FEFO (first expired, first out) concept, so I can check and see how many items for each material I have expiring on this and that date.

I would love for this to somehow be compatible with my current system.

Does anybody have any experience with this or good ideas? I would truly appreciate any inputs that I can get! If anybody has some nice videos, guides, links or anything that might help, please do not hesitate to drop those in the comments either

Thank you so much for your time everybody! It is truly appreciated

Best regards,
David

 

[jasonb75]

I assume that each row in the sheet is 1 of the 101 unique items. For what you're trying to do to work correctly it would be better to use that as a summary sheet, with a second sheet that records each receipt of an item on a separate row so that old and new are not being mixed.

Trying to squash it all into one record is never going to work properly, if at all.

 

[David77]

I assume that each row in the sheet is 1 of the 101 unique items. For what you're trying to do to work correctly it would be better to use that as a summary sheet, with a second sheet that records each receipt of an item on a separate row so that old and new are not being mixed.

Trying to squash it all into one record is never going to work properly, if at all.

Thank you Jason!

Do you have any videos or examples of how to do this?

BR.
David

 

[jasonb75]

I would use something like this, with the table on the left being the second sheet that I mentioned. Use a vba procedure similar to your existing one to create a new row on the left / second sheet for any new receipts and to deduct any usage from the oldest row greater than 0. This could be done using your existing entry method. I've used formulas in a couple of places but you could do it all with vba just as easily.

I'm not going to get chance to look at the code for a few days, see how you get on and I'll have another look at the weekend if you get stuck.

Book1
	A	B	C	D	E	F	G	H	I	J	K	L
1	Item	Received	Used	Remaining	Date		Item	Min	Stock	-	+	Last Updated
2	a	50	45	5	01/08/2020		a	6	55
3	b	50	40	10	01/08/2020
4	a	50	0	50	01/09/2020
Sheet2

Cell Formulas
Range	Formula
I2	I2	=SUMIF(A:A,G2,D:D)
D2:D4	D2	=B2-C2

 

[David77]

I would use something like this, with the table on the left being the second sheet that I mentioned. Use a vba procedure similar to your existing one to create a new row on the left / second sheet for any new receipts and to deduct any usage from the oldest row greater than 0. This could be done using your existing entry method. I've used formulas in a couple of places but you could do it all with vba just as easily.

I'm not going to get chance to look at the code for a few days, see how you get on and I'll have another look at the weekend if you get stuck.

Book1
	A	B	C	D	E	F	G	H	I	J	K	L
1	Item	Received	Used	Remaining	Date		Item	Min	Stock	-	+	Last Updated
2	a	50	45	5	01/08/2020		a	6	55
3	b	50	40	10	01/08/2020
4	a	50	0	50	01/09/2020
Sheet2

Cell Formulas
Range	Formula
I2	I2	=SUMIF(A:A,G2,D:D)
D2:D4	D2	=B2-C2

I will get back to this by friday - if I don't respond here, please have another look in the weekend - I would truly appreciate it!

Thank you SO very much for all your help so far though! It is greatly appreciated

 

[jasonb75]

Hi Dave,

I've done some quick test code based on the example sheet layout that I suggested in post 4. If you copy that to a blank sheet, then add this code to the sheet module you will be able to see the theory of what I was suggesting. I have allowed for some possible data entry errors but not all, for example entering anything other than a number into columns J or K will cause it to fail.

As I mentioned before, I've used a simplified format to demonstrate the idea, it will need adjusting to fit your actual layout and requirements.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rfound As Range, c As Range, nRow As Long
Application.EnableEvents = False
Select Case Target.Column
    Case 10
        If Cells(Target.Row, 7).Value = "" Then
            MsgBox "Please enter an item code in column G first!", vbCritical + vbOKOnly
            Target.ClearContents
        
        ElseIf Target.Value > Cells(Target.Row, 9).Value Then
            MsgBox "You do not have enough stock!", vbCritical + vbOKOnly
            Target.ClearContents
        Else
                Set c = Range("A1")
            Do
                Set rfound = Range("A:A").Find(Cells(Target.Row, 7), c, xlValues, xlWhole, xlByRows, xlNext, False, False, False)
                If Cells(rfound.Row, 4).Value >= Target.Value Then
                    Cells(rfound.Row, 4).Value = Cells(rfound.Row, 4).Value - Target.Value
                    Cells(rfound.Row, 3).Value = Cells(rfound.Row, 2).Value - Cells(rfound.Row, 4).Value
                    Target.ClearContents
                    Cells(Target.Row, 12).Value = Date
                Else
                    Target.Value = Target.Value - Cells(rfound.Row, 4).Value
                    Cells(rfound.Row, 4).Value = 0
                    Set c = rfound
                End If
                If Target.Value = 0 Then
                    Target.ClearContents
                    Exit Do
                End If
            Loop
        End If
    Case 11
        If Cells(Target.Row, 7).Value = "" Then
            MsgBox "Please enter an item code in column G first!", vbCritical + vbOKOnly
            Target.ClearContents
        Else
            nRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(nRow, 1).Value = Cells(Target.Row, 7).Value
            Cells(nRow, 2).Value = Target.Value
            Cells(nRow, 3).Value = 0
            Cells(nRow, 4).Value = Target
            Cells(nRow, 5).Value = Date
            Target.ClearContents
            Cells(Target.Row, 12).Value = Date
        End If
End Select
Application.EnableEvents = True
End Sub

 

[David77]

Hi Dave,

I've done some quick test code based on the example sheet layout that I suggested in post 4. If you copy that to a blank sheet, then add this code to the sheet module you will be able to see the theory of what I was suggesting. I have allowed for some possible data entry errors but not all, for example entering anything other than a number into columns J or K will cause it to fail.

As I mentioned before, I've used a simplified format to demonstrate the idea, it will need adjusting to fit your actual layout and requirements.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rfound As Range, c As Range, nRow As Long
Application.EnableEvents = False
Select Case Target.Column
    Case 10
        If Cells(Target.Row, 7).Value = "" Then
            MsgBox "Please enter an item code in column G first!", vbCritical + vbOKOnly
            Target.ClearContents
       
        ElseIf Target.Value > Cells(Target.Row, 9).Value Then
            MsgBox "You do not have enough stock!", vbCritical + vbOKOnly
            Target.ClearContents
        Else
                Set c = Range("A1")
            Do
                Set rfound = Range("A:A").Find(Cells(Target.Row, 7), c, xlValues, xlWhole, xlByRows, xlNext, False, False, False)
                If Cells(rfound.Row, 4).Value >= Target.Value Then
                    Cells(rfound.Row, 4).Value = Cells(rfound.Row, 4).Value - Target.Value
                    Cells(rfound.Row, 3).Value = Cells(rfound.Row, 2).Value - Cells(rfound.Row, 4).Value
                    Target.ClearContents
                    Cells(Target.Row, 12).Value = Date
                Else
                    Target.Value = Target.Value - Cells(rfound.Row, 4).Value
                    Cells(rfound.Row, 4).Value = 0
                    Set c = rfound
                End If
                If Target.Value = 0 Then
                    Target.ClearContents
                    Exit Do
                End If
            Loop
        End If
    Case 11
        If Cells(Target.Row, 7).Value = "" Then
            MsgBox "Please enter an item code in column G first!", vbCritical + vbOKOnly
            Target.ClearContents
        Else
            nRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(nRow, 1).Value = Cells(Target.Row, 7).Value
            Cells(nRow, 2).Value = Target.Value
            Cells(nRow, 3).Value = 0
            Cells(nRow, 4).Value = Target
            Cells(nRow, 5).Value = Date
            Target.ClearContents
            Cells(Target.Row, 12).Value = Date
        End If
End Select
Application.EnableEvents = True
End Sub

Hello Jason,

This is amazing, truly! Thank you so very much I apologize for my late response, but your code is really tremendous!!

I will have a longer look at this and see if I can get it to connect with the rest of my system well enough. I will return to you (if you have the time of course) in the future should I have any questions I will let you know of my progress soon enough!

Best regards,
David

 

[David77]

Hi Dave,

I've done some quick test code based on the example sheet layout that I suggested in post 4. If you copy that to a blank sheet, then add this code to the sheet module you will be able to see the theory of what I was suggesting. I have allowed for some possible data entry errors but not all, for example entering anything other than a number into columns J or K will cause it to fail.

As I mentioned before, I've used a simplified format to demonstrate the idea, it will need adjusting to fit your actual layout and requirements.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rfound As Range, c As Range, nRow As Long
Application.EnableEvents = False
Select Case Target.Column
    Case 10
        If Cells(Target.Row, 7).Value = "" Then
            MsgBox "Please enter an item code in column G first!", vbCritical + vbOKOnly
            Target.ClearContents
       
        ElseIf Target.Value > Cells(Target.Row, 9).Value Then
            MsgBox "You do not have enough stock!", vbCritical + vbOKOnly
            Target.ClearContents
        Else
                Set c = Range("A1")
            Do
                Set rfound = Range("A:A").Find(Cells(Target.Row, 7), c, xlValues, xlWhole, xlByRows, xlNext, False, False, False)
                If Cells(rfound.Row, 4).Value >= Target.Value Then
                    Cells(rfound.Row, 4).Value = Cells(rfound.Row, 4).Value - Target.Value
                    Cells(rfound.Row, 3).Value = Cells(rfound.Row, 2).Value - Cells(rfound.Row, 4).Value
                    Target.ClearContents
                    Cells(Target.Row, 12).Value = Date
                Else
                    Target.Value = Target.Value - Cells(rfound.Row, 4).Value
                    Cells(rfound.Row, 4).Value = 0
                    Set c = rfound
                End If
                If Target.Value = 0 Then
                    Target.ClearContents
                    Exit Do
                End If
            Loop
        End If
    Case 11
        If Cells(Target.Row, 7).Value = "" Then
            MsgBox "Please enter an item code in column G first!", vbCritical + vbOKOnly
            Target.ClearContents
        Else
            nRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(nRow, 1).Value = Cells(Target.Row, 7).Value
            Cells(nRow, 2).Value = Target.Value
            Cells(nRow, 3).Value = 0
            Cells(nRow, 4).Value = Target
            Cells(nRow, 5).Value = Date
            Target.ClearContents
            Cells(Target.Row, 12).Value = Date
        End If
End Select
Application.EnableEvents = True
End Sub

Hello again Jason,

Is there any way to update the code, so you can add in the expiration date as well when you enter the quantity and material name for the item in question?

Thank you!

Best regards,
David

 

[jasonb75]

That should be easy enough. Do expiration dates need to be taken into consideration when used material is deducted as well? For example, skip over any rows with stock greater then 0 has expired?

An example of your new layout would be useful in order to code the columns correctly.

 

[David77]

That should be easy enough. Do expiration dates need to be taken into consideration when used material is deducted as well? For example, skip over any rows with stock greater then 0 has expired?

An example of your new layout would be useful in order to code the columns correctly.

Hello Jason,

Awesome! Could you assist me on how to implement it? Sorry for my many questions, I'm still pretty new to VBA.

We apply a FEFO principle (first expired, first out), so whichever good is closest to the expiration date will be removed when we subtract materials from the list first.

Thank you so much!