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):
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):
Code:
Sub Sort_And_Match()
Application.ScreenUpdating = False
counter = 0
SortMultipleColumns
Matching
If counter = 1 Then
SortMultipleColumns
Matching
End If
Application.ScreenUpdating = True
End SubCode:
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 SubCode:
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