I want to divide data automatically by vba code

[chipchip]

I have a data sheet with 5 columns:Column A is the declaration number: assume there are 2 declaration numbers, 100 and 200.
Column B is the date: assume there are 2 corresponding dates, 08/22/2023 and 08/24/2023.
Column C is the code (identifier): assume the code is always NPL01.
Column D is the declaration amount: Corresponding to each declaration number, there are 1000 and 2000
.Column F is the product code: will be filled with the product code when the quantity is divided.

I also have an Allocation sheet with 5 columns:
Column A is the product code: assume there are 2 product codes, A100 and A200.
Column B is the quantity of products: corresponding quantities are 1000 and 2000.
Column C is the code (identifier): assume the code is always NPL01.
Column D is the standard: corresponding standards are 1.2 and 0.3.Column E is the requirement = quantity * standard.
Product Code Product Quantity Code Standard RequirementA100 1000 NPL01 1.2 1200A200 2000 NPL02 0.3 600

I want to use VBA code as follows:
If product code A100 requires 1200 using NPL01, then check if there are any declarations with code NPL,
if yes, determine the declaration amount.If the declaration amount = requirement, then use that declaration for product A100 and fill the product code in column F.
If the declaration amount > requirement, then multiply that declaration by 2. The original declaration amount will be 1200 corresponding to the requirement of product 100, and fill the product code in column F. The multiplied declaration amount will be the total old amount - 1200.
If the declaration amount > requirement, then use that declaration for product A100 and fill the product code in column F. Next, check if there are any declarations with code NPL01. If yes, check if the amount matches the remaining requirement. Then repeat the process as above, comparing the declaration amount with the remaining requirement.
Declaration Number Date Code Declaration Amount Product Code100; 08/22/2023;NPL01; 1000; A100 and 200; 08/24/2024; NPL01; 200; A100 and 200; 08/24/2024; NPL01; 600; A200 and 200; 08/24/2024; NPL01; 1200
This is the desired result for the given example. Please help i can solve this problem with vba code or any fastest possible way

 

[chipchip]

Here is the code I wrote but it runs very slow with big data even I can't wait. please help me improve this code

Sub ProcessData()
Dim wsDM As Worksheet, wsData As Worksheet
Dim lastRowDM As Long, lastRowData As Long, lastProcessedRow As Long
Dim i As Long, j As Long, z As Long, ItemDM As Variant, ItemData As Variant
Dim diff As Double, diff2 As Double
Dim newRow As Range, nextRow As Long

'dat lai ten cho sheet
Set wsDM = ThisWorkbook.Sheets("DM")
Set wsData = ThisWorkbook.Sheets("Data")

'tinh dong cuoi cho du lieu
lastRowDM = wsDM.Cells(wsDM.Rows.Count, "A").End(xlUp).Row
lastRowData = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row


wsData.Range("E2:E" & lastRowData).ClearContents

For i = 2 To lastRowDM
'Stop
styleDM = wsDM.Cells(i, 1).Value
ItemDM = wsDM.Cells(i, 3).Value
tConsDM = wsDM.Cells(i, 5).Value


lastRowData = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
For j = 2 To lastRowData

styleData = wsData.Cells(j, 5).Value 'ma hang dien sau
ItemData = wsData.Cells(j, 3).Value 'item Data
totalAmountData = wsData.Cells(j, 4).Value 'totaldata

If ItemDM = ItemData And styleData = "" Then

If totalAmountData = tConsDM Then
wsData.Cells(j, 5).Value = styleDM
Exit For

ElseIf totalAmountData > tConsDM Then

diff = totalAmountData - tConsDM
Set newRow = wsData.Rows(j + 1).EntireRow
newRow.Insert

wsData.Cells(j, 5).Value = styleDM
wsData.Cells(j, 4).Value = tConsDM

wsData.Cells(j + 1, 1).Value = wsData.Cells(j, 1).Value
wsData.Cells(j + 1, 2).Value = wsData.Cells(j, 2).Value
wsData.Cells(j + 1, 3).Value = ItemData
wsData.Cells(j + 1, 4).Value = diff
wsData.Cells(j + 1, 5).Value = ""



ElseIf totalAmountData < tConsDM Then
'Stop
diff = tConsDM - totalAmountData
wsData.Cells(j, 5).Value = styleDM



Dim foundRow As Range
Dim totalAmountFound As Double

Set foundRow = wsData.Range("C" & j & ":C" & lastRowData).Find(What:=ItemData, LookIn:=xlValues)
Do While Not foundRow Is Nothing
If wsData.Cells(foundRow.Row, 5).Value = "" Then
totalAmountFound = wsData.Cells(foundRow.Row, 4).Value
Exit Do
End If
Set foundRow = wsData.Range("C" & foundRow.Row + 1 & ":C" & lastRowData).Find(What:=ItemData, LookIn:=xlValues)

Loop


If Not foundRow Is Nothing Then

totalAmountFound = wsData.Cells(foundRow.Row, 4).Value


If totalAmountFound = diff Then
wsData.Cells(foundRow.Row, 5).Value = styleDM


ElseIf totalAmountFound > diff Then

Set newRow = wsData.Rows(foundRow.Row + 1).EntireRow
newRow.Insert

'Stop
wsData.Cells(foundRow.Row + 1, 1).Value = wsData.Cells(foundRow.Row, 1).Value
wsData.Cells(foundRow.Row + 1, 2).Value = wsData.Cells(foundRow.Row, 2).Value
wsData.Cells(foundRow.Row + 1, 3).Value = ItemData
wsData.Cells(foundRow.Row + 1, 4).Value = totalAmountFound - diff
wsData.Cells(foundRow.Row + 1, 5).Value = ""

wsData.Cells(foundRow.Row, 4).Value = diff
wsData.Cells(foundRow.Row, 5).Value = styleDM


'-------neu tongdata < chenh lech-----------

Else ' totalAmountFound < diff
'Stop
lastProcessedRow = foundRow.Row
'diff = tConsDM - totalAmountData
diff2 = diff 'tinh lai chenh lech
'wsData.Cells(lastProcessedRow, 5).Value = styleDM
nextRow = lastProcessedRow
Do While nextRow <= lastRowData
If wsData.Cells(nextRow, 3).Value = ItemData And wsData.Cells(nextRow, 5).Value = "" Then
totalAmountNextRow = wsData.Cells(nextRow, 4).Value
'diff2 = diff - totalAmountFound
If totalAmountNextRow = diff2 Then
wsData.Cells(nextRow, 5).Value = styleDM
Exit Do

ElseIf totalAmountNextRow > diff2 Then

diff3 = totalAmountNextRow - diff2
Set newRow = wsData.Rows(nextRow + 1).EntireRow
newRow.Insert

'Stop
wsData.Cells(nextRow, 5).Value = styleDM
wsData.Cells(nextRow, 4).Value = diff2

wsData.Cells(nextRow + 1, 1).Value = wsData.Cells(nextRow, 1).Value
wsData.Cells(nextRow + 1, 2).Value = wsData.Cells(nextRow, 2).Value
wsData.Cells(nextRow + 1, 3).Value = ItemData
wsData.Cells(nextRow + 1, 4).Value = diff3
wsData.Cells(nextRow + 1, 5).Value = ""

Else
'Stop
wsData.Cells(nextRow, 5).Value = styleDM
diff2 = diff2 - totalAmountNextRow

End If

End If
nextRow = nextRow + 1
Loop

End If
End If

End If

Exit For

End If
Next j
'Stop
Next i

End Sub