Excel VBA Code Upgradation help required
Dear VBA Developer,
The Excel file below contains two sheets: Master Data and RM Purchase.
https://1drv.ms/x/s!AiSRNak3QYCfha1PgPfgI3-lQY3igg?e=fLtC2B
In the Master Data sheet, Column B lists the Project Locations, with consumption data spanning from columns 34 to 54.
In the RM Purchase sheet, Column 3 also features Project Locations, with price information from columns 4 to 24 and Purchase Quantities from columns 25 to 45.
The code below calculates the cost of RM01 in Column 61 of the Master Data sheet.
I want to apply the same calculation method to determine the costs for RM02 through RM21 within the code modifications below. I expect your support.
Sub Costs_of_RM01()
Dim D() As Variant, B, CP, PP, PQ, R&, L&, M@
With Sheets("Master Data")
Dim LastRow As Long
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
B = .Range("B8:B" & LastRow).Resize(, 2).Value
CP = Sheets("RM Purchase").Range("C8:C" & LastRow).Value
PP = Sheets("RM Purchase").Range("D8:D" & LastRow).Value
PQ = Sheets("RM Purchase").Range("Y8:Y" & LastRow).Value
ReDim D(1 To LastRow - 7, 0)
For R = 8 To LastRow
Dim CompanyName As String
CompanyName = UCase(Trim(B(R - 7, 1)))
L = 0
For i = 1 To UBound(CP, 1)
If UCase(Trim(CP(i, 1))) = CompanyName Then
L = i
Exit For
End If
Next i
If L > 0 Then
Dim ConsumptionQuantity As Double
ConsumptionQuantity = .Cells(R, "AH").Value
If IsNumeric(ConsumptionQuantity) And ConsumptionQuantity > 0 Then
Dim RemainingConsumption As Double
RemainingConsumption = ConsumptionQuantity
Dim TotalCost As Double
TotalCost = 0
Do While RemainingConsumption > 0 And L <= UBound(CP, 1)
Dim PurchaseQty As Double
PurchaseQty = PQ(L, 1)
If PurchaseQty > 0 Then
Dim ConsumedQty As Double
If RemainingConsumption >= PurchaseQty Then
ConsumedQty = PurchaseQty
Else
ConsumedQty = RemainingConsumption
End If
TotalCost = TotalCost + (ConsumedQty * PP(L, 1))
RemainingConsumption = RemainingConsumption - ConsumedQty
PQ(L, 1) = PurchaseQty - ConsumedQty
End If
L = L + 1
Loop
D(R - 7, 0) = TotalCost
Else
D(R - 7, 0) = 0
End If
Else
D(R - 7, 0) = 0
End If
NextR:
Next R
.Range("BI8:BI" & LastRow) = D
End With
End Sub