Transaction to Inventory excel VBA using macro

MODERATOR NOTICE: This topic has also been posted on other sites and may already have an answer elsewhere. Please take this into consideration when answering this question

Hello guys!

I want to write a macro to receive data from the 'Transaction' sheet and gives me an 'Inventory' sheet but I don't know how to do it

(the 'Transaction' sheet may contain many shares so the macro should count them all and if we sell a share that we don't have in the first place,(short it) it should warn us)

could you please help me??

Hi There!

https://www.mrexcel.com/board/…-vba-using-macro.1158714/

and

https://www.excelforum.com/exc…xcel-vba-using-macro.html

Quote from KjBox

Try the attached.

Click the button on the Transaction sheet.

Code assigned to the button is:

Code

1. Sub Inventory()
2. Dim x, y, Ticker, i As Long, ii As Long, iii As Long
3. Dim iv As Long, v As Long, lBuy As Long, lSell As Long, d As Double
5. x = Sheet1.Cells(1).CurrentRegion
6. With CreateObject("scripting.dictionary")
7. For i = 2 To UBound(x, 1)
8. If Not .exists(x(i, 1)) Then .Add x(i, 1), Nothing
9. Next
10. Ticker = .keys
11. End With
12. ReDim y(1 To UBound(Ticker) + 4, 1 To 9)
13. For i = LBound(Ticker) To UBound(Ticker)
14. iii = iii + 1: iv = 0: v = 0
15. lBuy = 0: lSell = 0
16. For ii = 2 To UBound(x, 1)
17. If x(ii, 1) = Ticker(i) Then
18. y(iii, 1) = x(ii, 1)
19. If x(ii, 2) = "Buy" Then
20. y(iii, 2) = y(iii, 2) + x(ii, 3)
21. lBuy = lBuy + x(ii, 4): iv = iv + 1
22. Else
23. y(iii, 5) = y(iii, 5) + x(ii, 3)
24. lSell = lSell + x(ii, 4): v = v + 1
25. End If
26. If iv > 0 Then
27. y(iii, 4) = lBuy / iv: y(iii, 3) = y(iii, 2) * y(iii, 4)
28. End If
29. If v > 0 Then
30. y(iii, 7) = lSell / v: y(iii, 6) = y(iii, 5) * y(iii, 7)
31. End If
32. End If
33. Next
34. y(iii, 8) = y(iii, 8) + (y(iii, 2) - y(iii, 5))
35. y(iii, 9) = y(iii, 5) * (y(iii, 7) - y(iii, 4))
36. If y(iii, 8) < 0 Then Cells(iii + 1, 8).Font.Color = vbRed
37. d = d + y(iii, 3)
38. Next
39. y(UBound(y, 1), 3) = d
40. With Sheet2
41. .Cells(1).CurrentRegion.Offset(1).Clear
42. .Cells(2, 1).Resize(UBound(y, 1), 9) = y
43. .UsedRange.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
44. .UsedRange.Columns(8).NumberFormat = "0_ ;[Red]-0 "
45. .Activate
46. End With
48. End Sub

Display More

Note:

You had an error in your sample file, the average Buy for Share 1 should be 7,752 not 7,749

Any Short Sell will have the Inventory in Red text, I changed Share7 Sell to 4,000 to illustrate that.

Display More

Thank you very much, pal! that was so helpful;

my one question is because my language is Persian (Arabic letters) and if I want to change the cells to Persian,

would it require a special code? and would it destroy the code?

Quote from KjBox

Thanks for posting links to cross-posting.

Did you see my solution in Post#2?

yes, pal. really helpful thank you <3,

but from the code, I assumed that if I type the variables in Persian, the code won't work.

Quote from KjBox

Again, not certain.

I think you should try changing the sheet text to Persian and leaving the code variables in English.

If that works then try changing the code too.

Thank you very much.

there are some words like 'buy' or 'sell' that are in the code and when I changed them to Persian(buy=خريد sell=فروش),

they destroyed the code, but tickers work very nice.

any idea pal?

Quote from KjBox

In the code line 17 is If x(ii, 2) = "Buy" Then , try changing "Buy" to "خرید" but still within the quotation marks

Thank you Very much, pal.

solved!

Quote from KjBox

Please put a post in ExcelForum and MrExcel to say that the problem was solved at Ozgrid. Then people will not waste their time working on a solution for you.

Thanks.

sure

Quote from KjBox

You're welcome

Hi Mr.Charles,

I'm trying to understand the code and figure out which part is for which function.. but its a little bit complicated for me,

could you please give me some ropes about it??

thank you

Quote from KjBox

Here is the code with comments added, I hope it will help you follow and understand what each part does!

Code

1. Sub Inventory()
2. Dim x, y, Ticker, i As Long, ii As Long, iii As Long
3. Dim iv As Long, v As Long, lBuy As Long, lSell As Long, d As Double
5. ' Load all the data into array x
6. x = Sheet1.Cells(1).CurrentRegion
8. ' Scripting Dictionary is used to obtain a unique list of Tickers
9. ' That list is loaded into an array named "Ticker"
10. With CreateObject("scripting.dictionary")
11. For i = 2 To UBound(x, 1)
12. If Not .exists(x(i, 1)) Then .Add x(i, 1), Nothing
13. Next
14. Ticker = .keys
15. End With
17. ' Array y is resized according to the number of unique Tickers
18. ReDim y(1 To UBound(Ticker) + 4, 1 To 9)
20. ' Loop through the unique tickers
21. For i = LBound(Ticker) To UBound(Ticker)
23. ' Reset the variables for each iteration of the loop
24. iii = iii + 1: iv = 0: v = 0
25. lBuy = 0: lSell = 0
27. ' Loop through all the rows in array x (start at 2 to ignore headers)
28. For ii = 2 To UBound(x, 1)
30. ' Check if the Ticker of the second loop is the same as the first loop
31. If x(ii, 1) = Ticker(i) Then
33. ' If it is then start loading array y
34. y(iii, 1) = x(ii, 1)
36. ' Check if it is "Buy" or "Sell"
37. If x(ii, 2) = "Buy" Then '****CHANGE "BUY" TO PERSIAN SCRIPT****
39. ' Builds up the "Buy Volume" for each time a Ticker is encountered
40. y(iii, 2) = y(iii, 2) + x(ii, 3)
42. ' Because "Average Buying Price" is an average
43. ' it needs to be built differently, to avoid dividing by zero
44. ' lBuy is a variable that the Cost gets added to
45. lBuy = lBuy + x(ii, 4): iv = iv + 1
47. ' If not "Buy" then must be "Sell"
48. ' Sell works in exactly the same way as Buy
49. Else
50. y(iii, 5) = y(iii, 5) + x(ii, 3)
51. lSell = lSell + x(ii, 4): v = v + 1
52. End If
54. ' Now the "Average Buying Price" and "Average Sell Price"
55. ' Can be calculated and added to the array y
56. If iv > 0 Then
57. y(iii, 4) = lBuy / iv: y(iii, 3) = y(iii, 2) * y(iii, 4)
58. End If
59. If v > 0 Then
60. y(iii, 7) = lSell / v: y(iii, 6) = y(iii, 5) * y(iii, 7)
61. End If
62. End If
63. Next
65. ' Update the "Inventory" and "Profit/Loss" for each Ticker
66. y(iii, 8) = y(iii, 8) + (y(iii, 2) - y(iii, 5))
67. y(iii, 9) = y(iii, 5) * (y(iii, 7) - y(iii, 4))
69. ' If "Inventory" is negative then must be a Short Sell so font changes to red as a warning
70. If y(iii, 8) < 0 Then Cells(iii + 1, 8).Font.Color = vbRed
72. ' d is a variable that gets built to find the total "Cost" of all Transactions
73. d = d + y(iii, 3)
74. Next
76. ' After First Loop has run through all Tickers the total "Cost" is added to array y
77. y(UBound(y, 1), 3) = d
79. ' The Inventory sheet is cleared of any existing data
80. ' Then the contents of array y are placed on the sheet
81. ' The data then gets formatted correctly
82. With Sheet2
83. .Cells(1).CurrentRegion.Offset(1).Clear
84. .Cells(2, 1).Resize(UBound(y, 1), 9) = y
85. .UsedRange.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
86. .UsedRange.Columns(8).NumberFormat = "#,##0_ ;[Red]-#,##0 "
87. .Activate
88. End With
90. End Sub

Display More

Thank you