VBA to insert blank rows based on conditions

[aruncr]

Hello Experts,


I have a sheet with 6 columns.


Condition 1 - A blank row needs to be inserted whenever the Item (Column D) changes. I have the macro and it is working fine.


Condition 2 - Within an Item if a trade is closed off a blank row needs to be inserted, like
- If there is a Sale of 20 and then there is a purchase of 20
- If there is a Purchase of 100 and there are sales of 50, 25,25


Request your help for fulfilling Condition 2.

I am herewith attaching the excel file.

[Bob Phillips]

Sub Test()
Const colCat As String = "C"
Const colItem As String = "D"
Const colQty As String = "E"
Const colTemp As String = "G"
Dim BlankRows As Long, R As Long
Dim total As Double
Dim StartRow As Long, LastRow As Long
Dim SymVal As String, PSymVal As String

StartRow = 2
BlankRows = 1

Application.ScreenUpdating = False

With ActiveSheet

LastRow = .Cells(.Rows.Count, colItem).End(xlUp).Row

total = IIf(.Cells(StartRow, colCat).Value = "Sales", 1, -1) * .Cells(StartRow, colQty).Value
For R = StartRow + 1 To LastRow

.Rows(R).Select
If .Cells(R, colItem).Value = .Cells(R - 1, colItem).Value Then

total = total + IIf(.Cells(R, colCat).Value = "Sales", 1, -1) * .Cells(R, colQty).Value
If total = 0 Then

.Cells(R + 1, colTemp).Value = True
' total = IIf(.Cells(R, colCat).Value = "Sales", 1, -1) * .Cells(R, colQty).Value
End If
Else

total = IIf(.Cells(R, colCat).Value = "Sales", 1, -1) * .Cells(R, colQty).Value
End If
Next R

SymVal = .Cells(LastRow, colItem).Value

For R = LastRow To StartRow + 1 Step -1

If .Cells(R, colItem) <> SymVal Or .Cells(R + 1, colTemp).Value Then

.Cells(R + 1, colItem).EntireRow.Insert Shift:=xlDown
SymVal = .Cells(R, colItem).Value
End If
Next R

.Columns(colTemp).Clear
End With

Application.ScreenUpdating = True
End Sub

[aruncr]

Helo xld,

It worked like a charm.
Thanks a lot.

:clap2: