Running Inventory Using VBA

[bradyman97]

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

 

[Learn Excel in Tamil]

HI Bradyman,

Can you refer the file on google drive, https://drive.google.com/open?id=1csr2jWHNzzrKE-h3B-0sJ-Z_0FWyRddP

you can modify headers according to your sheet

or let me know if need to create specific macro for your

Thanks

 

[Peter_SSs]

@Learn Excel in Tamil
That file link has nothing to do with this question.
In any case, please refer to the last two paragraphs of #4 of the Forum Rules.

 

[Learn Excel in Tamil]

Thanks for the update

 

[bradyman97]

Learn Excel in Tamil,

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

 

[Learn Excel in Tamil]

Hi,

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

ProductID	ProductName	CurrentBalance
36807	TV	8
	=VLOOKUP(A2,Purchases!C1:D500,2,0)	=VLOOKUP(A2,Purchases!C1:E500,3,0)-VLOOKUP(A2,Transfers!C1:E500,3,0)

<tbody>
</tbody>

2nd if want Macro coding, please find the below

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

 

[bradyman97]

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

TransferDate	POnum	ProductID	ProductName	TransferQty	TransferPrice	TransferTotal
4/5/2018	5678	2000-0005	Apples	25	12.00	300.00
4/5/2018	5678	4321-5678	Oranges	50	12.00	600.00
4/5/2018	5678	1357-2468	Pears	75	12.00	900.00

<tbody>
</tbody>

Purchases

PurchaseDate	POnum	ProductID	ProductName	PurchaseQty	PurchasePrice	PurchaseTotal
4/1/2018	3456	2000-0005	Apples	100	12.00	120.00
4/1/2018	3456	4321-5678	Oranges	200	12.00	240.00
4/1/2018	3456	1357-2468	Pears	100	12.00	120.00

<tbody>
</tbody>

ProductList

ProductID	ProductName	CurrentBalance
2000-0005	apples	75
4321-5678	oranges	150
1357-2468	pears	25

<tbody>
</tbody>

 

[Learn Excel in Tamil]

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.

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

 

[bradyman97]

Hi Learn Excel in Tamil,

The code you gave me does not work properly. On the right side of your productlist I put a list of most of my productID and Product names. When I run your code it gives me a error and also the productID and ProductNames are wrong.

https://drive.google.com/file/d/1Ap4s0D7RdfoOKwQyanExf5-P7c1Wt6WR/view?usp=sharing

 

[Learn Excel in Tamil]

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