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

 

[Marc L]

​

It's often the issue when using Excel instead of a database software : 100 X slower !​

​

Under VBA there is the array way …​

 

[ghrek]

​

It's often the issue when using Excel instead of a database software : 100 X slower !​

​

Under VBA there is the array way …​

Many thanks but what do you mean by the array way as that's completely over my head?

 

[Marc L]

​

As Joe is near some mind reader he will certainly try another way like the array path …​

​

As I'm very beginner to guess anything I need the original csv file and a good enough elaboration about your need, the ins and outs,​

what should happen after, still a csv file so Excel is not the more appropriate tool or need a final result in a worksheet,​

so all details in order there is nothin' to guess to choose the more appropriate way under Excel (instead of some obvious faster tool) …​

 

[Marc L]

How many rows ?​

​

Checking the dates in column D is really necessary or just column G whatever the dates ?​

 

[ghrek]

Max of 150 rows and yes check column d and g

 

[Marc L]

​

So it can't be so long ‼​

​

If you can link your workbook on a files host website like Dropbox 'cause I have issues with your XL2BB attachment …​

 

[Joe4]

If there are only 150 rows, it should not take long at all to run.
Do you have any other VBA code running, especially any Event Procedure code?

If you run this slight variation, does it go any faster?

Sub MyMatchDeleteMacro()

    Dim lr As Long
    Dim r As Long
    
    Application.EnableEvents = False
    
'   Find last row in column D with data
    lr = Cells(Rows.Count, "D").End(xlUp).Row
    MsgBox "Last row is " & lr

'   Insert a blank column for column H
    Columns("H:H").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

'   Insert formula into column H until end of data
    Range("H2:H" & lr).FormulaR1C1 = _
        "=IF(RC[-1]=0,""DELETE"",IF(COUNTIFS(C[-4],RC[-4],C[-1],-RC[-1])=1,""DELETE"",""""))"

'   Convert formulas to hard-coded values
    Range("H2:H" & lr).Value = Range("H2:H" & lr).Value

'   Loop through all rows and delete marked rows
    Application.ScreenUpdating = False
    For r = lr To 2 Step -1
        If Cells(r, "H") = "DELETE" Then Rows(r).Delete
    Next r
    Application.ScreenUpdating = True
    
'   Delete temporary column H
    Columns("H:H").Delete Shift:=xlToLeft
    
    Application.EnableEvents = True
    
End Sub

Also, what does the message box return?

 

[Marc L]

According to post #6 attachment the Sort & Clear demonstration without formula neither a helper column & pretty quick as reducing the necessary iterations :​

Sub Demo1()
         Dim L&, Rg(3) As Range, V, F%, D&, R&
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    With [A1].CurrentRegion.Rows
         L = .Count
        .Sort .Cells(7), 1, Header:=1
         Set Rg(1) = .Columns(7).Find(0, , , 1, , 2)
    If Rg(1) Is Nothing Then
        V = Application.Lookup(0, .Columns(7))
        If IsError(V) Then Erase Rg: Exit Sub
        Set Rg(1) = .Columns(7).Find(V, , , 1, , 2)
         If Rg(1).Row = L Then Erase Rg: Exit Sub
        Set Rg(0) = .Range(.Cells(2, 7), Rg(1))
    Else
       Set Rg(0) = .Columns(7).Find(0, , , 1, , 1)
        If Rg(0).Row = 2 Then
            With .Range(Rg(0), Rg(1)):  .Value2 = Empty:  L = L - .Rows.Count:  End With
           .Sort .Cells(7), Header:=1
        ElseIf Rg(1).Row = L Then
            L = L - .Range(Rg(0), Rg(1)).Rows.Count
        End If
            If L < .Count Then .Item(L + 1 & ":" & .Count).Clear: Erase Rg: Exit Sub
            With .Range(Rg(0), Rg(1)):  .Value2 = Empty:  L = L - .Rows.Count:  End With
            Set Rg(0) = .Range(.Cells(2, 7), Rg(0)(0))
    End If
         Set Rg(1) = .Range(Rg(1)(2), .Cells(.Count, 7))
         F = 1 + (Rg(0).Count > Rg(1).Count)
    For Each Rg(2) In Rg(1 - F)
           Set Rg(3) = Rg(F).Find(-Rg(2).Value2, , , 1, , 1)
        If Not Rg(3) Is Nothing Then
                   D = Rg(2)(1, -2).Value2
                   R = Rg(3).Row
            Do
                    If Rg(3)(1, -2).Value2 = D Then L = L - 2: Union(Rg(2), Rg(3)).Value2 = Empty: Exit Do
                   Set Rg(3) = Rg(F).FindNext(Rg(3))
            Loop Until Rg(3).Row = R
        End If
    Next
        If L < .Count Then .Sort .Cells(7), Header:=1: .Item(L + 1 & ":" & .Count).Clear
    End With
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
        Erase Rg
End Sub

 

[ghrek]

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

 

[Tivakaran]

How about you use the Remove Duplicate function instead?