David77

Board Regular
Joined
Jun 24, 2020
Messages
109
Office Version
  1. 365
Platform
  1. Windows
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:

1599229654983.png


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
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
12,959
Office Version
  1. 365
Platform
  1. Windows
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

Board Regular
Joined
Jun 24, 2020
Messages
109
Office Version
  1. 365
Platform
  1. Windows
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

Well-known Member
Joined
Dec 30, 2008
Messages
12,959
Office Version
  1. 365
Platform
  1. Windows
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
ABCDEFGHIJKL
1ItemReceivedUsedRemainingDateItemMinStock-+Last Updated
2a5045501/08/2020a655
3b50401001/08/2020
4a5005001/09/2020
Sheet2
Cell Formulas
RangeFormula
I2I2=SUMIF(A:A,G2,D:D)
D2:D4D2=B2-C2
 

David77

Board Regular
Joined
Jun 24, 2020
Messages
109
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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
ABCDEFGHIJKL
1ItemReceivedUsedRemainingDateItemMinStock-+Last Updated
2a5045501/08/2020a655
3b50401001/08/2020
4a5005001/09/2020
Sheet2
Cell Formulas
RangeFormula
I2I2=SUMIF(A:A,G2,D:D)
D2:D4D2=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

Well-known Member
Joined
Dec 30, 2008
Messages
12,959
Office Version
  1. 365
Platform
  1. Windows
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.
VBA Code:
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

Board Regular
Joined
Jun 24, 2020
Messages
109
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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

Board Regular
Joined
Jun 24, 2020
Messages
109
Office Version
  1. 365
Platform
  1. Windows
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.
VBA Code:
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

Well-known Member
Joined
Dec 30, 2008
Messages
12,959
Office Version
  1. 365
Platform
  1. Windows
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

Board Regular
Joined
Jun 24, 2020
Messages
109
Office Version
  1. 365
Platform
  1. Windows
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! :)
 

Watch MrExcel Video

Forum statistics

Threads
1,133,463
Messages
5,658,918
Members
418,476
Latest member
Tristram_ZX81

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