Macro which sorts and matches entries not working but not erroring

[Nick_G]

Hi all,

I've done some programming in Python and R but this is my first foray into VBA so my apologies if any of this turns out to be an absurdly stupid question!

I'm trying to write some VBA code which will do the following two tasks.

1: Sorts a range of data by Name and then by Absolute Value

2: Looks through the sorted data, and if two rows have the same Name and Values which sum to zero, deletes both rows.

As it stands, the code I've written works some of the time, but not all of the time. I've attached a spreadsheet with examples of where it works and where it fails. The code behaves as expected for "Anna" and "Tom" but fails for Jack. It should delete both entries as the names are the same and the values are the same.

Any advice would be greatly appreciated.

The code is as follows (a text box is assigned to the first piece of code (Sort_And_Match):

Sub Sort_And_Match()

Application.ScreenUpdating = False


counter = 0

SortMultipleColumns
Matching

If counter = 1 Then
    SortMultipleColumns
    Matching
    
End If


    
Application.ScreenUpdating = True

End Sub

Sub Matching()

Application.ScreenUpdating = False

Numrows = Range("A1", Range("A1").End(xlDown)).Rows.Count

Set Rng = Range("A2:A" & Numrows)


For Each Cell In Rng
    RowNumber = Cell.Row
    RowNumberPlus = RowNumber + 1
    
    If Range("B" & RowNumber) = -Range("B" & RowNumberPlus) Then
    
        If Range("A" & RowNumber) = Range("A" & RowNumberPlus) Then
            Range("A" & RowNumber).Resize(2).EntireRow.Delete
            counter = 1
            
            
            
        End If
    End If
    
    Next Cell


End Sub

Sub SortMultipleColumns()

Numrows = Range("A1", Range("A1").End(xlDown)).Rows.Count
Set Rng = Range("A2:B" & Numrows)

Columns("C").EntireColumn.Insert


For Each Cell In Rng
    RowNumber = Cell.Row
    
    Range("C" & RowNumber).Value = Abs(Range("B" & RowNumber))
    
       
    Next Cell


With ActiveSheet.Sort
    .SortFields.Clear
    .SortFields.Add Key:=Range("A1"), Order:=xlAscending
    .SortFields.Add Key:=Range("C1"), Order:=xlAscending
    .SetRange Range("A1:C" & Numrows)
    .Header = xlYes
    .Apply
    
    Range("C" & RowNumber).EntireColumn.Delete

End With
End Sub