VBA delete rows that offset eachother - excel

Question

I am trying to eliminate line items that cancel each other out.
For example, below the two rows that add to zero would be deleted (i.e., 87.1 and -87.1).
-87.1
890
87.1
898989
The code that I am using mostly works but in cases where there are numerous lines with the same values it is deleting all of them instead of just one matching value per observation. For example, below, I would want it to cancel out two of the -87.1s and two of the 87.1s but one would be leftover because there is no number directly offsetting it.
-87.1
890
87.1
898989
87.1
-87.1
-87.1
Sub x()
Dim n As Long, rData As Range
Application.ScreenUpdating = False
n = Range("C" & Rows.Count).End(xlUp).Row
Range("AV2:AV" & n).Formula = "=IF(I2=0,0,COUNTIFS($C$2:$C$" & n & ",C2,$I$2:$I$" & n & ",-I2))"
With ActiveSheet
.AutoFilterMode = False
.Rows(1).AutoFilter field:=48, Criteria1:=">0"
With .AutoFilter.Range
On Error Resume Next
Set rData = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rData Is Nothing Then
rData.EntireRow.Delete shift:=xlUp
End If
End With
.AutoFilterMode = False
End With
Application.ScreenUpdating = True
End Sub

Answer 1

I think you need something like this:
Sub DeleteOppositeNumbers()
Dim Fnd As Range, r As Long
'By: Abdallah Ali El-Yaddak
Application.ScreenUpdating = False
'Loop through the column bottom to top.
For r = Range("C" & Rows.Count).End(xlUp).Row To 2 Step -1
If Cells(r, 3).Value > 0 Then 'If the value is positive
'Sreach for it's opposite
Set Fnd = Columns(3).Find(-Cells(r, 3).Value, LookAt:=xlWhole)
'If found, delete both.
If Not Fnd Is Nothing Then Rows(r).Delete: Fnd.EntireRow.Delete
End If
Next
'Just to restore normal behaviour of sreach
Set Fnd = Columns(3).Find(Cells(3, 2).Value, LookAt:=xlPart)
Application.ScreenUpdating = True
End Sub

Answer 2

Perhaps Something Simpler:
Sub x()
Dim ar() As Variant
Dim i As Integer
Dim j As Integer
Dim n As Integer
n = Range("C" & Rows.Count).End(xlUp).Row
Range("AV2:AV" & n).Formula = "=IF(I2=0,0,COUNTIFS($C$2:$C$" & n & ",C2,$I$2:$I$" & n & ",-I2))"
ar = ActiveSheet.Range("AV2:AV" & last).Value
For i = LBound(ar) To UBound(ar)
For j = LBound(ar) To UBound(ar)
If i <> j Then
If ar(i, 1) = ar(j, 1) Then
ar(i, 1) = ""
ar(j, 1) = ""
End If
End If
Next
Next
For i = LBound(ar) To UBound(ar)
ActiveSheet.Range("AV" & i + 1).Value = ar(i, 1)
Next
ActiveSheet.Range("AV2:AV" & last).SpecialCells(xlCellTypeBlanks).Delete xlUp
End Sub
I have tried and tested this one.

Answer 3

You could try:
Option Explicit
Sub test()
Dim arr As Variant
Dim LastRow As Long, i As Long, j As Long
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
arr = Range("A1:A" & LastRow)
For i = UBound(arr) To LBound(arr) Step -1
For j = UBound(arr) - 1 To LBound(arr) Step -1
If arr(i, 1) + arr(j, 1) = 0 Then
.Rows(i).EntireRow.Delete
.Rows(j).EntireRow.Delete
Exit For
End If
Next j
Next i
End With
End Sub