How do I delete matching positive and negative entries in a column

[ghrek]

Hi

In column G of my workbook I have lots of positive and negative values. Im trying to get it to look all the way down column G and if there is a matching positive and negative entry of the same value I need the rows they are on completely deleting.

Any Ideas?

Thanks

 

[Akuini]

Max of 150 rows and yes check column d and g

Do you think it could be my PC as it starts to run on excel then comes up NOT RESPONDING

Try copy-paste your data as values to a new workbook, then run the code on it.

 

[Marc L]

Do you think it could be my PC as it starts to run on excel then comes up NOT RESPONDING. Would it work on office 365

Should work on 365 yes … As on our sides the codes well work … If only you link your source text file or a workbook sample​

on a files host website like Dropbox in order we can test and give it a try for some faster way if really necessary …​

 

[ghrek]

Its strange. It appears to be working them comes up as not responding and then only way I can get out of it is to crash excel via task manager

Heres the actual file im using.

OneDrive

Sign in to your OneDrive cloud storage and Office Online.

1drv.ms

 

[Marc L]

​

When 'not responding' that often just means Excel is very busy with a VBA procedure execution …​

I will give it a cry try if my slow tests laptop stops to crash today ! ​

 

[Marc L]

​

How many rows ?​

Max of 150 rows and yes check column d and g

How could you explain your 150 rows answer as your post #23 attachment contains 636 015 rows ?‼ ​

So yes under Excel it needs some time then you need to be patient & wait …​

 

[ghrek]

Sorry I was told about 150 so that may be the reason why it taking so long?

 

[Marc L]

Obviously yes in particular when the procedure was not made for huge data !​

​

In the For Each loop add before the Next codeline this one :​

            If Rg(2).Row Mod 30 = 0 Then DoEvents

​

As a reminder huge data often needs to be treated under a database software …​

​

 

[ghrek]

Thanks

Tell u what it is over the complete workbook I have a difference of an amount and I’m trying to find out what makes that difference. Is there any other way I can approach it?

 

[Marc L]

Under Excel ? Yes but I must first find back my post on another forum to try to adapt the procedure to your data …​

​

Maybe Joe as some ready to go procedure …​

 

[Akuini]

@ghrek
Try this:
The code sort the data by col D. If it's not ok then I can amend the code to sort it back to the initial order.
I use col H as temporary helper column.
The code took about 8 second to finish:

Sub positive_negative_match2()
'positive-negative match, GROUP
Dim i As Long, z As Long, a As Long
Dim va, vb, vc, m, s, t
Dim d As Object

t = Timer
Application.ScreenUpdating = False
With Range("A1").CurrentRegion
.Sort Key1:=.Cells(1, 4), Order1:=xlAscending, Header:=xlYes
End With
n = Range("D" & Rows.Count).End(xlUp).Row
va = Range("D1:D" & n)
vc = Range("G1:G" & n)
ReDim vb(1 To n, 1 To 1)

For i = 1 To n
    vb(i, 1) = "x" 'mark for NOT positive-negative match
Next
Set d = CreateObject("scripting.dictionary")

For i = 2 To n
d.RemoveAll
    Do
    z = vc(i, 1)
       
        If d.Exists(z) Then
            d(z) = d(z) & ":" & i
        ElseIf d.Exists(-z) Then
            s = Split(d(-z), ":")
            m = s(UBound(s))
            vb(i, 1) = "" 'mark for positive-negative match
            vb(m, 1) = "" 'mark for positive-negative match
                If UBound(s) = 0 Then
                    d.Remove -z
                    Else
                    d(-z) = Left(d(-z), Len(d(-z)) - Len(m) - 1)
                End If
        Else
            d(z) = i
        End If
        i = i + 1
        If i > UBound(va, 1) Then Exit Do
    Loop While va(i, 1) = va(i - 1, 1)
    i = i - 1

Next

Range("H1").Resize(n, 1) = vb
With Range("A1").CurrentRegion
    .Sort Key1:=.Cells(1, 8), Order1:=xlAscending, Header:=xlYes
    a = Range("H" & Rows.Count).End(xlUp).Row + 1
    Rows(a & ":" & n).Delete
    Range("H:H").Delete
End With
Application.ScreenUpdating = True

Debug.Print Timer - t
End Sub

If you want to check whether the code works correctly or not, you can comment this part:

'With Range("A1").CurrentRegion
'    .Sort Key1:=.Cells(1, 8), Order1:=xlAscending, Header:=xlYes
'    a = Range("H" & Rows.Count).End(xlUp).Row + 1
'    Rows(a & ":" & n).Delete
'    Range("H:H").Delete
'End With

then check col H, the blank cells in col H are the ones that have positive-negative match on the same date, so they are going to be deleted.