How to delete certain Ranges

Question

Question: How to find all cells in column G which are not contained in column A?

Situation: I have 2 columns of data. They consist (apart from +/- 3000 rows) of the same data. One of the columns is approximatly 7k rows, the other is about 10k rows long. There are no blank spaces. Both columns consist of cells of 10 digit numbers and are ordered ascending. A cellvalue in column A may or may not be in column G and vice versa.

I need to delete all cells in column G which are not contained in column A.

I have tried the following:

Sub Delete_rows()

Dim p As Long
Dim LastRow As Long
Dim g As Long

Worksheets("Vergleich").Activate
Range("A2").Select
LastRow = Cells.SpecialCells(xlCellTypeLastCell).row

For g = 1 To LastRow
    'ActiveCell is the first cell in column A, 6 positions to the right is 
    'column G
    If ActiveCell.value = ActiveCell.Offset(0, 6).value Then
        ActiveCell.Offset(1, 0).Select
    Else
        'As I ve said there are numbers in column A that are no contained in 
        'column G which is why I ve tried to work arround this one but ofc 
        'this is not an elegant solution.
        If ActiveCell.value = 4225201001# Then
            ActiveCell.Offset(1, 0).Select
        Else
            'selects the cell in column G that is not contained in column A.
            Range(ActiveCell.Offset(0, 6), ActiveCell.Offset(0, 9)).Select
            Selection.Delete
            ActiveCell.Offset(0, -6).Select
        End If
    End If

Next g

End Sub

This doesnt work since it doesnt take the few values in column A that are not contained in column G into account.

Note that it is possible that there are repeating numbers in a column. I know that i have a lot of selects and activecells in my code but keep in mind i m fairly new to vba and i find it easier to debug the code this way since you can visually see what the program is doing step by step.

Since the excel file is quite big i need an efficient solution to my problem, othwerwise the macro will run forever.

Thanks in advance for your help.

Best regards

Here is a screenshot after running the recommended macro.

Answer 1

This is exactly what Application.Match function was designed for.

Also, there is no need to use ActiveCell, and ActiveCell.Offset(1, 0).Select and Selection.Delete, you can modify/delete the object directly with fully qualified objects.

Code

Option Explicit

Sub Delete_rows()

Dim LastCell As Range, MatchRng As Range
Dim p As Long, g As Long, LastRow As Long

Application.ScreenUpdating = False

With Worksheets("Vergleich")
    ' safest way to get the last row
    Set LastCell = .Cells.Find(What:="*", After:=.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, _
                        searchorder:=xlByRows, searchdirection:=xlPrevious, MatchCase:=False)
    If Not LastCell Is Nothing Then
        LastRow = LastCell.Row
    Else
        MsgBox "Error! worksheet is empty", vbCritical
        End
    End If

    ' set the range where we want to look for the match
    Set MatchRng = .Range("A1:A" & LastRow)

    ' always loop backwards when deleting cells
    For g = LastRow To 1 Step -1
        ' current value in column "G" is not found in column "B" >> delete this record
        If IsError(Application.Match(.Range("G" & g).Value, MatchRng, 0)) Then
            .Range("G" & g).Delete xlShiftUp
        End If
    Next g
End With

Application.ScreenUpdating = True

End Sub

---

Edit 1: a faster way will be to delete the entire cells at once, using a DelRng object, that adds another cell from column "G" to this range, each time it's not found in column "A".

Modified section of Code

Dim DelRng As Range

' always loop backwards when deleting cells
For g = LastRow To 1 Step -1
    ' current value in column "G" is not found in column "B" >> delete this record
    If IsError(Application.Match(.Range("G" & g).Value, MatchRng, 0)) Then
        If Not DelRng Is Nothing Then
            Set DelRng = Application.Union(DelRng, .Range("G" & g))
        Else
            Set DelRng = .Range("G" & g)
        End If
    End If
Next g

' delete the entire cells at once >> save run-time
If Not DelRng Is Nothing Then DelRng.Delete xlShiftUp