VBA for a Profit Calculation

M

mollerrr

New Member
Joined
Jan 4, 2024
Messages
2
Office Version
  1. 365
Platform
  1. Windows
DateTypeStockPriceQuantityAmountVBACorrect
04-01-2024BoughtMINM
3,960​
1039,60
04-01-2024SoldMINM
3,900​
1039,00-0,60-0,60
04-01-2024BoughtMINM
4,060​
1040,60-
04-01-2024BoughtMINM
3,760​
1037,60-
04-01-2024SoldMINM
4,130​
2082,607,404,40
04-01-2024BoughtMINM
4,220​
521,10-
04-01-2024SoldMINM
4,280​
521,400,300,30
04-01-2024BoughtMINM
4,200​
521,00-
04-01-2024BoughtMINM
3,920​
519,60-
04-01-2024BoughtMINM
3,860​
519,30-
04-01-2024BoughtMINM
3,840​
519,20-
04-01-2024SoldMINM
4,000​
2080,002,800,90
04-01-2024BoughtMINM
4,330​
28,66-
04-01-2024SoldMINM
4,460​
28,921,240,26
04-01-2024BoughtMINM
4,490​
28,98-
04-01-2024SoldMINM
4,400​
28,800,14-0,18
04-01-2024BoughtMINM
4,580​
29,16-
04-01-2024SoldMINM
4,630​
29,260,280,10
04-01-2024BoughtMINM
5,500​
316,50-
04-01-2024SoldMINM
5,320​
15,320,74-0,18
04-01-2024SoldMINM
5,320​
210,64-0,36-0,36
04-01-2024BoughtMINM
5,170​
315,51-
04-01-2024SoldMINM
5,080​
315,24-0,27-0,27
04-01-2024BoughtMINM
5,270​
526,35-
04-01-2024SoldMINM
5,280​
526,400,050,05
04-01-2024BoughtMINM
5,330​
210,66-
04-01-2024SoldMINM
5,140​
210,28-0,38-0,38
04-01-2024BoughtMINM
5,185​
210,37-
04-01-2024SoldMINM
5,213​
210,430,060,06
04-01-2024BoughtOMGA
5,588​
15,59-
04-01-2024SoldOMGA
5,596​
15,600,010,01

I have this data and I want to calculate the Profit automatically. I have a code but it does not function when I have more than 1 buy or sell, I will put the code below, any help would be fantastic, thank you!

Sub CalculateProfit()
Dim lastRow As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("SheetName") ' Replace "YourSheetName" with the actual sheet name

' Find the last row with data in column A
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

' Array to store matched transactions
Dim matchedTransactions() As Boolean
ReDim matchedTransactions(2 To lastRow) ' Assuming data starts from row 2

' Loop through the transactions in reverse order
For i = lastRow To 2 Step -1
If ws.Cells(i, 2).Value = "Sold" And Not matchedTransactions(i) Then ' Check if it's an unmatched sale transaction
Dim sellPrice As Double
Dim quantity As Integer
Dim buyPrice As Double

' Get the sell price and quantity from the sale transaction
sellPrice = ws.Cells(i, 4).Value
quantity = ws.Cells(i, 5).Value

' Find the first unmatched buy transaction for the same stock
For j = i - 1 To 2 Step -1
If ws.Cells(j, 3).Value = ws.Cells(i, 3).Value And ws.Cells(j, 2).Value = "Bought" And Not matchedTransactions(j) Then
buyPrice = ws.Cells(j, 4).Value
matchedTransactions(j) = True ' Mark the buy as matched
Exit For
End If
Next j

' Calculate profit and update the "Amount" column
If buyPrice <> 0 Then
Dim profit As Double
profit = (sellPrice - buyPrice) * quantity
ws.Cells(i, 7).Value = profit
End If
End If
Next i
End Sub
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Sort by date Sort by votes
moll Let's get the ball rolling. Now I ran your program, and it looks like I got some different results than you. One question I have is it possible to start in cell B2 or the top and work our way down? The first transaction is a buy so it should work. So let's start the discussion. There is going to lots more questions.

24-01-05.xlsm
ABCDEFGHI
1DateTypeStockPriceQuantityAmountVBACorrect
24/1/2024BoughtMINM3,9601039,60
34/1/2024SoldMINM3,9001039,00-600-0,60
44/1/2024BoughtMINM4,0601040,60-
54/1/2024BoughtMINM3,7601037,60-
64/1/2024SoldMINM4,1302082,6074004,40
74/1/2024BoughtMINM4,220521,10-
84/1/2024SoldMINM4,280521,403000,30
94/1/2024BoughtMINM4,200521,00-
104/1/2024BoughtMINM3,920519,60-
114/1/2024BoughtMINM3,860519,30-
124/1/2024BoughtMINM3,840519,20-
134/1/2024SoldMINM4,0002080,0028000,90
144/1/2024BoughtMINM4,33028,66-
154/1/2024SoldMINM4,46028,9212400,26
164/1/2024BoughtMINM4,49028,98-
174/1/2024SoldMINM4,40028,80140-0,18
184/1/2024BoughtMINM4,58029,16-
194/1/2024SoldMINM4,63029,262800,10
204/1/2024BoughtMINM5,500316,50-
214/1/2024SoldMINM5,32015,32740-0,18
224/1/2024SoldMINM5,320210,64-360-0,36
234/1/2024BoughtMINM5,170315,51-
244/1/2024SoldMINM5,080315,24-270-0,27
254/1/2024BoughtMINM5,270526,35-
264/1/2024SoldMINM5,280526,40500,05
274/1/2024BoughtMINM5,330210,66-
284/1/2024SoldMINM5,140210,28-380-0,38
294/1/2024BoughtMINM5,185210,37-
304/1/2024SoldMINM5,213210,43560,06
314/1/2024BoughtOMGA5,58815,59-
324/1/2024SoldOMGA5,59615,6080,01
Data


VBA Code: 
Sub CalculateProfit()
Dim lastRow As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Data") ' Replace "YourSheetName" with the actual sheet name

' Find the last row with data in column A
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

' Array to store matched transactions
Dim matchedTransactions() As Boolean
ReDim matchedTransactions(2 To lastRow) ' Assuming data starts from row 2

' Loop through the transactions in reverse order
For i = lastRow To 2 Step -1
If ws.Cells(i, 2).Value = "Sold" And Not matchedTransactions(i) Then ' Check if it's an unmatched sale transaction
Dim sellPrice As Double
Dim buyPrice As Double

' Get the sell price and quantity from the sale transaction
sellPrice = ws.Cells(i, 4).Value
quantity = ws.Cells(i, 5).Value

' Find the first unmatched buy transaction for the same stock
For j = i - 1 To 2 Step -1
If ws.Cells(j, 3).Value = ws.Cells(i, 3).Value And ws.Cells(j, 2).Value = "Bought" And Not matchedTransactions(j) Then
buyPrice = ws.Cells(j, 4).Value
matchedTransactions(j) = True ' Mark the buy as matched
Exit For
End If
Next j

' Calculate profit and update the "Amount" column
If buyPrice <> 0 Then
Dim profit As Double
profit = (sellPrice - buyPrice) * quantity
ws.Cells(i, 7).Value = profit
End If
End If
Next i
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Locked
  • Question Question
VBA Code to fill in tables?
Replies
1
Views
411
Fluff
Fluff
Z
  • Solved
Changes required in VBA code
Replies
8
Views
607
Zubair
Z
A
  • Question Question
vba code - build logic around percentage change calculations
Replies
0
Views
853
abhi_jain80
A
N
  • Question Question
First in First Out (Fifo) Stock balance Calaculation File.
Replies
2
Views
10K
TotallyConfused
T
A
  • Question Question
Vba
Replies
2
Views
494
Arjan77
Arjan77

Forum statistics

Threads
1,224,734
Messages
6,180,631
Members
452,991
Latest member
JM_000888

Share this page

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