Sorry, after reading your last data I don’t think I can find a good solution for your problem. So maybe someone else here could help.

But I added some lines in the code just to mark the section (with X) where the code can't find the solution, so at least you know where to look, to do it manually.

Here’s the revised code:

Code:

Sub a1086996c()
*'https://www.mrexcel.com/forum/excel-questions/1086996-excel-formula-vba-conditional-sum-find-contra-multiple-entries.html*
Dim i As Long, j As Long, n As Long
Dim x As Long, k As Long, z As Long
Dim q As Long
Dim va, vb, vc
Dim flag As Boolean
Application.ScreenUpdating = False
n = Range("C" & Rows.count).End(xlUp).Row
va = Range("C1:C" & n)
vb = Range("K1:K" & n)
ReDim vc(1 To n, 1 To 2)
Range("L1:M" & n).ClearContents
For i = 2 To UBound(va, 1)
j = i: x = 0
Do
x = x + vb(i, 1)
i = i + 1
If i > UBound(va, 1) Then Exit Do
Loop While va(i, 1) = va(i - 1, 1)
i = i - 1
vc(i, 2) = x
If x = 0 Then GoTo skip:
If x < 0 Then
For k = j To i
vb(k, 1) = vb(k, 1) * -1
Next
x = x * -1
End If
For k = j To i
z = 0
For q = j To k
z = z + vb(q, 1)
Next
flag = False
If z = x Then
vc(k, 1) = 1: vc(k, 1) = "WPI": flag = True: GoTo skip:
ElseIf z > x Then
vb(k, 1) = 0
Else
If vb(k, 1) <= 0 Then
vb(k, 1) = 0
Else
vc(k, 1) = "WPI"
End If
End If
Next
skip:
If flag = False Then
For k = j To i
vc(k, 1) = "X"
Next
End If
Next
Range("L1").Resize(UBound(vc, 1), 2) = vc
Range("L1") = "Manual"
Application.ScreenUpdating = True
End Sub

## Like this thread? Share it with others