I created a User defined Function in vba to calculate profits according to First in - First out inventory system. Before moving to the real code, I want to make a few checks on weather the input is valid or not.
'---------------Check Information for errors----------------------
SellSum = Application.WorksheetFunction.Sum(SellQuantity)
BuySum = Application.WorksheetFunction.Sum(BuyQuantity)
SellPCount = Application.WorksheetFunction.Count(SellPrice)
SellQCount = Application.WorksheetFunction.Count(SellQuantity)
BuyPCount = Application.WorksheetFunction.Count(BuyPrice)
BuyQCount = Application.WorksheetFunction.Count(BuyQuantity)
If SellSum > BuySum Then 'More sales than inventory, throw error
FIFO_PROFIT = VBA.CVErr(XlCVError.xlErrValue)
End If
If (BuyPCount <> BuyQCount Or SellPCount <> SellQCount) Then 'Incomplete data, throw error
FIFO_PROFIT = VBA.CVErr(XlCVError.xlErrValue)
End If
'-----------------------------------------------------------------
And after the real code, I have the final value,
FIFO_PROFIT = RunningProfit
But,when I entered invalid data, that should have raised the errors, it didn't do anything. It was like it just skipped the error checking and jumped to the actual code.
The actual code is a little lengthy and I don't believe it to have any relation with it. But if anyone wants to review it, https://pastebin.com/fA2pY52f
I'd say something like this might work:
Function FIFO_PROFIT(SellPrice As Variant, SellQuantity As Variant, BuyPrice As Variant, BuyQuantity As Variant) As Variant
'Calculate the Profit according to the FIFO method
'---------------Check Information for errors----------------------
SellSum = Application.WorksheetFunction.Sum(SellQuantity)
BuySum = Application.WorksheetFunction.Sum(BuyQuantity)
SellPCount = Application.WorksheetFunction.Count(SellPrice)
SellQCount = Application.WorksheetFunction.Count(SellQuantity)
BuyPCount = Application.WorksheetFunction.Count(BuyPrice)
BuyQCount = Application.WorksheetFunction.Count(BuyQuantity)
If SellSum > BuySum Then 'More sales than inventory, throw error
FIFO_PROFIT = VBA.CVErr(XlCVError.xlErrValue)
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
GoTo FIFO_PROFIT_IS_ERROR '<--------------------ADDED CODE (1 of 3)X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
End If
If (BuyPCount <> BuyQCount Or SellPCount <> SellQCount) Then 'Incomplete data, throw error
FIFO_PROFIT = VBA.CVErr(XlCVError.xlErrValue)
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
GoTo FIFO_PROFIT_IS_ERROR '<--------------------ADDED CODE (2 of 3)X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
End If
'-----------------------------------------------------------------
'--------------MoreVariables--------------------------------------
Dim RunningSale As Variant
Dim RunningBuy As Variant
Dim RunningCost As Variant
Dim RunningBuyQuantity As Variant
Dim RunningSales As Variant
Dim RunningProfit As Variant
Dim Residual As Variant
Dim UsedupResidual As Variant
Dim y As Variant
y = 1
RunningCost = 0
Residual = 0
UsedupResidual = 0
RunningSales = 0
RunningProfit = 0
'-----------------------------------------------------------------
For x = 1 To SellQCount
If y <> 1 Then 'BUGtest
RunningBuyQuantity = Residual + BuyQuantity(y).Value2
End If
While (RunningBuyQuantity <= SellQuantity(x).Value2 And y <= BuyQCount) 'Bugtest
If y = 1 Then
RunningCost = RunningCost + (BuyPrice(y).Value2 * BuyQuantity(y).Value2)
Else
RunningCost = RunningCost + ((BuyPrice(y).Value2 * BuyQuantity(y).Value2) + (BuyPrice(y - 1).Value2 * Residual))
End If
Residual = 0
RunningBuyQuantity = RunningBuyQuantity + BuyQuantity(y).Value2
y = y + 1
Wend
If RunningBuyQuantity > SellQuantity(x).Value2 Then
Residual = SellQuantity(x).Value2 - RunningBuyQuantity
UsedupResidual = BuyQuantity(y).Value2 - Residual
RunningCost = RunningCost + (UsedupResidual * BuyPrice(y).Value2)
End If
RunningSales = SellPrice(x).Value2 * SellQuantity(x).Value2
RunningProfit = RunningProfit + RunningSales - RunningCost
RunningSales = 0
RunningCost = 0
Next x
FIFO_PROFIT = RunningProfit
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
FIFO_PROFIT_IS_ERROR: '<--------------------ADDED CODE (3 of 3) X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
End Function
I've taken your whole function and added 3 lines of code. I didn't check the code itself, so no evalutation about it. In the two cases (more sales and incomplete data) the FIFO_PROFIT is correctly set as you already did and then the GoTo instruction send the code to the FIFO_PROFIT_IS_ERROR line, conveniently placed at the end of the function. More information about the GoTo instruction here.
Then again, you could also use the Exit Function instruction. It would not need the third line FIFO_PROFIT_IS_ERROR and it would also work. It would result in this:
Function FIFO_PROFIT(SellPrice As Variant, SellQuantity As Variant, BuyPrice As Variant, BuyQuantity As Variant) As Variant
'Calculate the Profit according to the FIFO method
'---------------Check Information for errors----------------------
SellSum = Application.WorksheetFunction.Sum(SellQuantity)
BuySum = Application.WorksheetFunction.Sum(BuyQuantity)
SellPCount = Application.WorksheetFunction.Count(SellPrice)
SellQCount = Application.WorksheetFunction.Count(SellQuantity)
BuyPCount = Application.WorksheetFunction.Count(BuyPrice)
BuyQCount = Application.WorksheetFunction.Count(BuyQuantity)
If SellSum > BuySum Then 'More sales than inventory, throw error
FIFO_PROFIT = VBA.CVErr(XlCVError.xlErrValue)
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Exit Function '<--------------------ADDED CODE (1 of 2)X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
End If
If (BuyPCount <> BuyQCount Or SellPCount <> SellQCount) Then 'Incomplete data, throw error
FIFO_PROFIT = VBA.CVErr(XlCVError.xlErrValue)
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Exit Function '<--------------------ADDED CODE (1 of 2)X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
End If
'-----------------------------------------------------------------
'--------------MoreVariables--------------------------------------
Dim RunningSale As Variant
Dim RunningBuy As Variant
Dim RunningCost As Variant
Dim RunningBuyQuantity As Variant
Dim RunningSales As Variant
Dim RunningProfit As Variant
Dim Residual As Variant
Dim UsedupResidual As Variant
Dim y As Variant
y = 1
RunningCost = 0
Residual = 0
UsedupResidual = 0
RunningSales = 0
RunningProfit = 0
'-----------------------------------------------------------------
For x = 1 To SellQCount
If y <> 1 Then 'BUGtest
RunningBuyQuantity = Residual + BuyQuantity(y).Value2
End If
While (RunningBuyQuantity <= SellQuantity(x).Value2 And y <= BuyQCount) 'Bugtest
If y = 1 Then
RunningCost = RunningCost + (BuyPrice(y).Value2 * BuyQuantity(y).Value2)
Else
RunningCost = RunningCost + ((BuyPrice(y).Value2 * BuyQuantity(y).Value2) + (BuyPrice(y - 1).Value2 * Residual))
End If
Residual = 0
RunningBuyQuantity = RunningBuyQuantity + BuyQuantity(y).Value2
y = y + 1
Wend
If RunningBuyQuantity > SellQuantity(x).Value2 Then
Residual = SellQuantity(x).Value2 - RunningBuyQuantity
UsedupResidual = BuyQuantity(y).Value2 - Residual
RunningCost = RunningCost + (UsedupResidual * BuyPrice(y).Value2)
End If
RunningSales = SellPrice(x).Value2 * SellQuantity(x).Value2
RunningProfit = RunningProfit + RunningSales - RunningCost
RunningSales = 0
RunningCost = 0
Next x
FIFO_PROFIT = RunningProfit
End Function