Home » excel » excel – Delete rows from table if entries duplicate another table

excel – Delete rows from table if entries duplicate another table

Posted by: admin May 14, 2020 Leave a comment

Questions:

Been a while since I worked with VBA so bear with me as I may be a little bit rusty.

I have 2 tables. One is what I call a “Deleted” list with a few columns and the other is a more detailed list with all details. What I want to do is look up items on the “Deleted” list (see Table 1) and if all the items in a row match the relevant items in the main list (see Table 2), then delete the row. I cannot just do the first column, as data is not very well structured.

Table 1 (Deleted)

+-------------------+---------+-----------------+-----------------------+----------+
|       Name        | Source  |     Tel No      |       Address 1       | Postcode |
+-------------------+---------+-----------------+-----------------------+----------+
| A N OTHER         | MySrc   | 01234 123456    | 18 FAKE STREET        | XXX XXXX |
| A N OTHER         | MySrc2  | 01234 567890    | 29 FAKE STREET        | XXX XXXX |
+-------------------+---------+-----------------+-----------------------+----------+

Table 2 (Main)

+---------------+-------+-----------+-----------+---------------+-------------+-------------------+----------------+----------------+----------------+----------+-------------+-------------+--------+--------+--------+--------+--------+--------+------------+--------+
| Name          | Title | Full Name | Job Title |  Tel No       | Tel No 2    |  Address Line 1   | Address Line 2 | Address Line 3 | Address Line 4 | Postcode |   Data 1    |   Data 2    | Data 3 | Data 4 | Data 5 | Data 6 | Data 7 | Data 8 | Date Added | Source |
+---------------+-------+-----------+-----------+---------------+-------------+-------------------+----------------+----------------+----------------+----------+-------------+-------------+--------+--------+--------+--------+--------+--------+------------+--------+
|  AN OTHER     |       | Person A  |           | 01234 123456  |             | 18 FAKE STREET    |                |                |                | XXX XXXX |             |             |        |        |        |        |        |        |            | MySrc  |
|  AN OTHER     |       | Person B  |           | 01234 999999  |             | 18 FAKE STREET    |                |                |                | XXX XXXX |             |             |        |        |        |        |        |        |            | MySrc  |
|... about another 5000 rows...
+---------------+-------+-----------+-----------+---------------+-------------+-------------------+----------------+----------------+----------------+----------+-------------+-------------+--------+--------+--------+--------+--------+--------+------------+--------+

As you can see from this, it should delete line 1 but leave line 2.

I have the following VBA code that I have written, which currently finds the rows where the duplicates exist based on one column only.

Sub createFinalList()
Dim rng As Range, Dim r As Range
Dim wsFinal As Worksheet, wsOriginal As Worksheet, wsDelete As Worksheet

Set wsFinal = ThisWorkbook.Sheets("FinalList")
Set wsOriginal = ThisWorkbook.Sheets("List")
Set wsDelete = ThisWorkbook.Sheets("PermaDelete")

For i = wsDelete.UsedRange.Rows.Count To 2 Step -1
    Set r = wsOriginal.Columns(1).Find(wsDelete.Cells(i, 1).Value, , xlValues, xlWhole, xlByRows, xlNext)
    If Not r Is Nothing Then
        firstA = r.Address
        Set rng = Nothing
        Do
            If rng Is Nothing Then
                Set rng = wsOriginal.Rows(r.Row)
            Else
                Set rng = Union(r, rng)
            End If
            Set r = wsOriginal.Columns(1).Find(wsDelete.Cells(i, 1).Value, r, xlValues, xlWhole, xlByRows, xlNext)
            Debug.Print r.Address
        Loop Until firstA = r.Address
    End If
Next i
End Sub

What I was thinking of doing was then using .Find on rngfor each subsequent column before deleting the final result, however it does seem like there should be an easier way. Am I missing a trick? Is there an easier way to do this?

How to&Answers:

If your ‘Deleted’ data exactly correspond with the ‘Main’ data you could use AdvancedFilter. Read more about advanced filter here: http://www.excel-easy.com/examples/advanced-filter.html HTH

Sub createFinalList()
    Dim mainSheet As Worksheet
    Dim criteriaSheet As Worksheet

    Set mainSheet = ThisWorkbook.Worksheets("Main")
    Set criteriaSheet = ThisWorkbook.Sheets("Deleted")

    Dim mainRange As Range
    Dim criteriaRng As Range

    Set mainRange = mainSheet.Range("A2:U3")
    Set criteriaRng = criteriaSheet.Range("A1:E3")

    mainRange.AdvancedFilter _
        Action:=xlFilterInPlace, _
        criteriaRange:=criteriaRng, _
        Unique:=False

    ' Delete rows hidden by advanced filter
    Dim myRow As Range
    Dim toDelete As Range

    For Each myRow In mainRange.Rows
        If myRow.EntireRow.Hidden Then
            If toDelete Is Nothing Then
                Set toDelete = myRow
            Else
                Set toDelete = Union(toDelete, myRow)
            End If
        End If
    Next

    If Not toDelete Is Nothing Then _
        toDelete.Delete
End Sub

Answer:

Can you do a non-VBA approach? It’s always the same columns that you look up?

  • Make a compound column of all your columns in the “deleted” table
    “=a1 & b1 & c1″…
  • Make a similar “lookup” column on your main table
  • Add a flag column in the main table doing a vlookup “=vlookup(c1,deletedrowslookupcolumn,1,false)”
  • Filter on your flag column
  • Delete the filtered rows

Answer:

I got this working through coming to the same conclusion as @mlinth and used a concatenated string to use in the .Find method. I added a column to the end of Table 2 which was the concatenation of just the required columns in the same order as Table 1. Also, I could then delete a whole row there and then, so had to amend my .Find statement in the loop so it no longer started from r (which had just been deleted)

Dim r As Range
Dim wsOriginal As Worksheet, wsDelete As Worksheet
Set wsOriginal = ThisWorkbook.Sheets("List")
Set wsDelete = ThisWorkbook.Sheets("PermaDelete")
Dim str As String
For i = wsDelete.UsedRange.Rows.Count To 2 Step -1
    str = wsDelete.Cells(i, 1).Value & wsDelete.Cells(i, 2).Value & wsDelete.Cells(i, 3).Value & wsDelete.Cells(i, 4).Value & wsDelete.Cells(i, 5).Value
    Set r = wsOriginal.Columns(30).Find(str, , xlValues, xlWhole, xlByRows, xlNext)
    Do until r Is Nothing Then
        wsOriginal.Rows(r.Row).EntireRow.Delete
        Set r = wsOriginal.Columns(30).Find(str, , xlValues, xlWhole, xlByRows, xlNext)
    Loop
Next i