Delete Rows with Conditions

[Lenard]

Hi,

I have a table below with duplicates of numeric text in column E, there is no problem using excel formula COUNTIF to remove duplicates
However, if I were to remove each row of duplicates with conditions that the corresponding value of duplicate in column F is Positive and also the next value of the same duplicate in the same column F is
negative and both values of that duplicate in column F sum up equal to zero
In this case, duplicate of 123456 found at E1, E2 and E4 but it has positive value of 70 at F1 and F2 and also negative value of 70 at F4
Row 1 and 4 will be deleted as the duplicate of 123456 has both value at F1 ( ie 1st positive value ) & F4 sum up equal to zero
The removal of duplicates will go on until there is no duplicate found or there is no zero value found after sum up of two duplicate's value , ie only unique numeric text remain in the table
E.g.
Column E F
Doc No Amt
1 123456 70
2 123456 70
3 654321 -1560
4 123456 -70
5 654321 1560
6 654321 -1560

Result
Doc No Amt
2 123456 70
6 654321 -1560

How to use excel formula or excel vba codes to achieve the result by removing duplicates with the above conditions

I would be much appreciated if you could offer a solution to the above scenario

Thanks

Regards
Len

 

[texasalynn]

what about doing a pivot table?

 

[Lenard]

I'm using 2007 Excel, there is a limitation in Pivot Table to find and match zero value

Perhaps, you have a better idea to share with me

Thanks

 

[mirabeau]

for the problem as posted. results in cols H and I

Sub testcode()
Dim a As Variant, n As Long
Dim d As Object, i As Long, e
n = Range("E:E")(Rows.Count).End(3).Row
a = Range("E1").Resize(n, 2)
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(a, 1) 'assume there is header
e = a(i, 1)
If d(e) = vbNullString Then d(e) = a(i, 2) Else d(e) = d(e) + a(i, 2)
Next i
For Each e In d
    If d(e) = 0 Then d.Remove (e)
Next e
Range("H2").Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
End Sub

 

[Lenard]

Thank!.........

After testing your codes, it works great.

It would be even much better to include error handle in your codes so that to avoid run time error "Type Mismatch" when both values of duplicate sum up to zero and there is no more row remaining in the table to delete

Could you please do it............... Thanks

Cheers
Len

 

[Lenard]

To include error handle, I think the last part of your codes can be modified as follows :-

If d.Count > 0 Then
Range("H2").Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
End If

Perhaps, in stead of using "Transpose" to list out the result in column H, how about deleting the related rows of duplicate when their values sum up to zero and the result only shows the remaining rows where there is no duplicate found or the values of duplicate sum up not equal to zero

It would be greatful if you could just modify your codes to include this effect

Thanks

Cheers
Len

 

[mirabeau]

Your suggestion regarding error handling is good. Here's a modified code which may do what you want including the other bit.

Sub testcode2()
Dim a As Variant, n As Long
Dim d As Object, i As Long, e
n = Range("E:E")(Rows.Count).End(3).Row
a = Range("E1").Resize(n, 2)
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(a, 1) 'assume there is header
e = a(i, 1)
If d(e) = vbNullString Then d(e) = a(i, 2) Else d(e) = d(e) + a(i, 2)
Next i
For Each e In d
    If d(e) = 0 Then d.Remove (e)
Next e
Range("E2").Resize(n - 1, 2).ClearContents
If d.Count > 0 Then
    Range("E2").Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
Else
    MsgBox "All variables deleted"
End If
End Sub

Note however that the code only addresses the example that was posted.
If say you have:

E F
No Amt
123456 36
123456 34
654321 -1560
123456 -70
654321 1560
654321 -1560

Then all of the 123456's will be deleted.
Your example was ambiguous about what you want in such situation, so I chose the easier option ...

 

[Lenard]

Thanks for staying with me
Your codes work perfectly! and the result achieves the objective
Sorry, my example posted was not clear as I was too excited to set the scenario first time

Consider 2nd Example based on your scenario where this table contains data start from A2 to G7

The condition to remove each ROW of duplicate found when their values sum up to zero is now changed to :-
a) Remove EntireRow of duplicate found when their values sum up to zero and
b) Sum up to zero is applied to same value with positive and negative sign
( ie -1560 + 1560 = 0 for 654321 Duplicate)

The result will show as follows :-

<TABLE style="WIDTH: 192pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=256><COLGROUP><COL style="WIDTH: 48pt" span=4 width=64><TBODY><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; WIDTH: 48pt; HEIGHT: 15pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl63 height=20 width=64>Col A to D</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl63 width=64>E</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl63 width=64>F</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl63 width=64>G</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl63 height=20>xxx</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl63>123456</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl63>36</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl63>xx</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl63 height=20>xxx</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl63>123456</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl63>34</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl63>xx</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl63 height=20>xxx</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl63>123456</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl63>-70</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl63>xx</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl63 height=20>xxx</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl63>654321</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl63>-1560</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" class=xl63>xx</TD></TR></TBODY></TABLE>


In this case, you will notice that the condition to delete duplicates found when their values sum up to zero will not apply for the value of duplicate 123456 where 36+34-70 = 0

It would be greatful if you could modify your codes again to achieve this effect

Thanks again.....

Cheers
Len

 

[mirabeau]

Hey Len,

Try this one

Sub nextcode()
Dim nr As Long, a As Range, i As Long, j As Long
nr = Range("E:E")(Rows.Count).End(3).Row
Set a = Range("E:F").Resize(nr, 2)
For i = 1 To nr
    For j = i + 1 To nr
        If a(i, 2).Value = -a(j, 2).Value Then
            If a(i, 1) = a(j, 1) Then
                Cells.Rows(i).ClearContents
                Cells.Rows(j).ClearContents
                Exit For
            End If
        End If
    Next j
Next i
For i = nr To 1 Step -1
   If Application.CountA(Cells.Rows(i)) = 0 Then _
        Cells.Rows(i).Delete
Next i
End Sub

 

[Lenard]

Well Done Mirabeau............

You are Great!
Your codes work perfectly