Hi Omey,

This is what I've got so far but were there any credit-debit matches in your sample?

Sub Omey(): Dim f As Long, r As Long: f = 2
GetCred:
Do Until Range("F" & f) < 0 Or Range("F" & f) = ""
f = f + 1: Loop
If Range("F" & f) = "" Then Exit Sub
GetDeb:
r = 2: Do Until Range("A" & r) = Range("A" & f) And Range("F" & r) > 0: r = r + 1
If Range("A" & r) = "" Then
f = f + 1: GoTo GetCred: End If: Loop
If Range("F" & r) >= Abs(Range("F" & f)) Then
Range("F" & r) = Range("F" & r) + Range("F" & f)
Range("F" & f).EntireRow.Delete Shift:=xlUp
Else: Range("F" & f) = Range("F" & r) + Range("F" & f)
GoTo GetDeb: End If
GoTo GetCred
End Sub