Sub DeleteRowsBasedOnConditions()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim sumBC As Double
Set ws = ThisWorkbook.Sheets("Sheet1")
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For i = lastRow To 2 Step -1
If ws.Cells(i, 1).Value = ws.Cells(i - 1, 1).Value Then
sumBC = ws.Cells(i, 2).Value + ws.Cells(i, 3).Value
If sumBC >= 0 Then
Do
ws.Rows(i).Delete
i = i - 1
sumBC = sumBC + ws.Cells(i, 3).Value
Loop While sumBC >= 0 And i > 1
End If
End If
Next i
End Sub
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim sumBC As Double
Set ws = ThisWorkbook.Sheets("Sheet1")
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For i = lastRow To 2 Step -1
If ws.Cells(i, 1).Value = ws.Cells(i - 1, 1).Value Then
sumBC = ws.Cells(i, 2).Value + ws.Cells(i, 3).Value
If sumBC >= 0 Then
Do
ws.Rows(i).Delete
i = i - 1
sumBC = sumBC + ws.Cells(i, 3).Value
Loop While sumBC >= 0 And i > 1
End If
End If
Next i
End Sub