Running Inventory Using VBA

bradyman97

Board Regular
Joined
Feb 22, 2008
Messages
60
Office Version
  1. 2019
I'm new to VBA and was hoping someone could help me with a running inventory using a VBA code. I have 3 sheets (ProductList, Purchases, Transfers). What I am trying to do is calculate at CurrentBalance for each individual product (so far 500 products) in the ProductList. When I enter the data in the PurchaseQty and TransferQty I would like the current balance to change.



ProductList column headers are: ProductID, ProductName, CurrentBalance

Purchases column headers are: PurchaseDate, POnum, ProductID, ProductName, PurchaseQty, PurchasePrice, PurchaseTotal

Transfers column headers are: TransferDate, POnum, ProductID, ProductName, TransferQty, TransferPrice, TransferTotal
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
Learn Excel in Tamil,

Yes my headers can be modified. If you can get a macro to work that's fine with me that
 
Upvote 0
Hi,

This can be done by two ways, once with look up function

[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]ProductID[/TD]
[TD] ProductName[/TD]
[TD] CurrentBalance[/TD]
[/TR]
[TR]
[TD]36807[/TD]
[TD]TV[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]=VLOOKUP(A2,Purchases!C1:D500,2,0)[/TD]
[TD]=VLOOKUP(A2,Purchases!C1:E500,3,0)-VLOOKUP(A2,Transfers!C1:E500,3,0)[/TD]
[/TR]
</tbody>[/TABLE]

2nd if want Macro coding, please find the below

Code:
Private Sub Worksheet_Change(ByVal Target As Range) '[SIZE=1][B]coded like when you change the product name in drop down[/B][/SIZE]
If Target.Address = "$A$2" Then
Call Currentbalance                '[SIZE=1][B]Call the Macro coding which put on module for easy understanding[/B][/SIZE]           
MsgBox "Macro completed"
End If
End Sub


Sub Currentbalance()
Dim ProduceID As String
Dim PurchaseQty As Double
Dim TransferQty As Double
ProduceID = Worksheets("Productlist").Range("A2").Value
Worksheets("Purchases").Select
Range("C1:C10").Find(what:=ProduceID).Select
Selection.Find(what:=ProduceID).Select
Worksheets("Productlist").Range("B2").Value = ActiveCell.Offset(0, 1).Value
PurchaseQty = ActiveCell.Offset(0, 2).Value
Worksheets("Transfers").Select
Range("C:C").Find(what:=ProduceID).Select
TransferQty = ActiveCell.Offset(0, 2).Value
Worksheets("Productlist").Range("C2").Value = PurchaseQty - TransferQty
Worksheets("Productlist").Activate
End Sub


Also files saved in google drive for your quick reference.

Lookup : https://drive.google.com/open?id=1mhI9q2YlaMJyMZ4nEIxjvUweoEYgVMFF
VBA : https://drive.google.com/open?id=16AgDZPuQy6rpLsNUSr39qMiafyi2N85-

Please let me know if this is not fulfill your requirement.

Thanks!
Learn Excel in Tamil
 
Upvote 0
Thanks for the reply Learn Excel in Tamil. But I don't think it's what I'm for unless I did something wrong.

What I am look for is a code for example that adds the apples purchase 100 and subtracts the apple transfers 25 for a total of 75. The 75 I need to show up in the ProductList in the CurrentBalance column for apples. Then the code goes the Oranges, Pears, etc.. As of right now for about 500 products. Is this possible to do?



Transfers
[TABLE="width: 500"]
<tbody>[TR]
[TD]TransferDate[/TD]
[TD]POnum[/TD]
[TD]ProductID[/TD]
[TD]ProductName[/TD]
[TD]TransferQty[/TD]
[TD]TransferPrice[/TD]
[TD]TransferTotal[/TD]
[/TR]
[TR]
[TD]4/5/2018[/TD]
[TD]5678[/TD]
[TD]2000-0005[/TD]
[TD]Apples[/TD]
[TD]25[/TD]
[TD]12.00[/TD]
[TD]300.00[/TD]
[/TR]
[TR]
[TD]4/5/2018[/TD]
[TD]5678[/TD]
[TD]4321-5678[/TD]
[TD]Oranges[/TD]
[TD]50[/TD]
[TD]12.00[/TD]
[TD]600.00[/TD]
[/TR]
[TR]
[TD]4/5/2018[/TD]
[TD]5678[/TD]
[TD]1357-2468[/TD]
[TD]Pears[/TD]
[TD]75[/TD]
[TD]12.00[/TD]
[TD]900.00[/TD]
[/TR]
</tbody>[/TABLE]


Purchases
[TABLE="width: 500"]
<tbody>[TR]
[TD]PurchaseDate[/TD]
[TD]POnum[/TD]
[TD]ProductID[/TD]
[TD]ProductName[/TD]
[TD]PurchaseQty[/TD]
[TD]PurchasePrice[/TD]
[TD]PurchaseTotal[/TD]
[/TR]
[TR]
[TD]4/1/2018[/TD]
[TD]3456[/TD]
[TD]2000-0005[/TD]
[TD]Apples[/TD]
[TD]100[/TD]
[TD]12.00[/TD]
[TD]120.00[/TD]
[/TR]
[TR]
[TD]4/1/2018[/TD]
[TD]3456[/TD]
[TD]4321-5678[/TD]
[TD]Oranges[/TD]
[TD]200[/TD]
[TD]12.00[/TD]
[TD]240.00[/TD]
[/TR]
[TR]
[TD]4/1/2018[/TD]
[TD]3456[/TD]
[TD]1357-2468[/TD]
[TD]Pears[/TD]
[TD]100[/TD]
[TD]12.00[/TD]
[TD]120.00[/TD]
[/TR]
</tbody>[/TABLE]





ProductList
[TABLE="width: 500"]
<tbody>[TR]
[TD]ProductID[/TD]
[TD]ProductName[/TD]
[TD]CurrentBalance[/TD]
[/TR]
[TR]
[TD]2000-0005[/TD]
[TD]apples[/TD]
[TD]75[/TD]
[/TR]
[TR]
[TD]4321-5678[/TD]
[TD]oranges[/TD]
[TD]150[/TD]
[/TR]
[TR]
[TD]1357-2468[/TD]
[TD]pears[/TD]
[TD]25[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Hi bradyman97,

Here is the coding for your reference, since you need to run for the all value on the excel i put Run button, when we ever you click on Run button, Current balance will be reflecting on the Column C, and this will run until blank rows on Column A.

Code:
Sub Currentbalance()
Dim ProduceID As String
Dim PurchaseQty As Double
Dim TransferQty As Double
Worksheets("Productlist").Select
Range("A2").Select
Do While ActiveCell.Value <> ""
ProduceID = ActiveCell.Value
Worksheets("Purchases").Select
Range("C1:C10000").Find(what:=ProduceID).Select
Selection.Find(what:=ProduceID).Select
ActiveCell.Offset(0, 1).Copy
Worksheets("Productlist").Select
Range("A1:A10000").Find(what:=ProduceID).Select
ActiveCell.Offset(0, 1).PasteSpecial
Worksheets("Purchases").Select
Range("C1:C10000").Find(what:=ProduceID).Select
Selection.Find(what:=ProduceID).Select
PurchaseQty = ActiveCell.Offset(0, 2).Value
Worksheets("Transfers").Select
Range("C:C").Find(what:=ProduceID).Select
TransferQty = ActiveCell.Offset(0, 2).Value
Worksheets("Productlist").Select
ActiveCell.Offset(0, 1).Value = PurchaseQty - TransferQty
Worksheets("Productlist").Activate
ActiveCell.Offset(1, -1).Select
Loop


End Sub

Also find drive path : https://drive.google.com/open?id=1zZE0MdM_ddngpcWlNIobmrK2b21yMpSJ

Thanks!
Learn Excel in Tamil
 
Upvote 0
Hi Brady,

i though you will have purchase ID and product name in single row, but in such case i need to code for filter and sum function, will do it and get back to you shortly

Thanks!

Regards,
Learn Excel in Tamil
 
Upvote 0

Forum statistics

Threads
1,223,896
Messages
6,175,265
Members
452,627
Latest member
KitkatToby

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
Back
Top