Removing Duplicates by Comparing to Another Sheet (Duplicate Removal Sheet has multiple header rows too)

[AutoMation42]

Hi again everyone,

I am sure what I seek to achieve is possible in VBA but it is far beyond my rudimentary skills. There are a couple things I want to do so any help that could be provided will be greatly appreciated. I am going to break the questions up and do one at a time. The first thing I would like to do in a nut shell is compare one sheet to another and remove duplicates from the first sheet. One sheet has constantly changing and updating information we will call this "Sheet 2" and sometimes causes there to be multiple ID's on another sheet which we will call "Sheet 1". I want to compare the ID numbers on "Sheet 1" to the ID numbers on "Sheet 2" and if there is any overlap I want the duplicate to be removed from "Sheet 1". The complications are that "Sheet 1" is broken up into sections so there are different titles for each section and as a result multiple header rows. I have included a picture of a section of what "Sheet 1" looks like (there are many more sections than just the two shown all with a different title but the same headers in the same order). Complication 2 is "Sheet 2" is the same idea but it has 1 single title in cell "A1" and a single header row in "row 2". Complication 3 is that "Sheet 2" has many more columns of data so even though it is 1 header row there are many more header names which means the ID column locations wont always match up. The last complication is that this code has to be dynamic because the headers while they will keep the same names, could have their order moved around on both sheets. The last piece is that I provided fake information to keep everything confidential. The columns that I need to compare by as shown in the image are Columns "A" and "B" so header names "Variable1" and "Variable2" and I may have to add additional columns to sort by if my boss wishes so. If any more information needs to be provided please let me know and I will do my best to provide it. Thank you in advance for any help provided!

 

[DanteAmor]

You need to adjust some data in the macro. So reading your information:
---

One sheet ... updating information we will call this "Sheet 2" and .. another sheet which we will call "Sheet 1".

Fit in this part:

  Set sh1 = Sheets("Sheet 1")
  Set sh2 = Sheets("Sheet 2")

---

Complication 2 is "Sheet 2"... a single header row in "row 2".

Fit in this part:

  hrow = 2          'single header row in sheet 2

---

The columns that I need to compare by as shown in the image are Columns "A" and "B" so header names "Variable1" and "Variable2"

Fit in this part:

  Set var1 = sh1.Range("A3")    'On Sheet 1, Cell where header is (Variable1)
  Set var2 = sh1.Range("B3")    'On sheet 1, Cell where header is (Variable2)

---

On a copy of your sheet1 try this:

Sub DeleteRows()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim rng As Range, rng2 As Range, f As Range, c As Range, var1 As Range, var2 As Range
  Dim cad As String
  Dim col1 As Long, col2 As Long, i As Long, hrow As Long
  Dim dic As Object
  
  'Fit to your data
  Set sh1 = Sheets("Sheet 1")
  Set sh2 = Sheets("Sheet 2")
  Set var1 = sh1.Range("A3")    'On Sheet 1, Cell where header is (Variable1)
  Set var2 = sh1.Range("B3")    'On sheet 1, Cell where header is (Variable2)
  hrow = 2                      'single header row in sheet 2
  
  Set dic = CreateObject("Scripting.Dictionary")
  
  Set f = sh2.Rows(hrow).Find(var1.Value, , xlValues, xlWhole, , , False)
  If f Is Nothing Then MsgBox "Header " & var1 & " does not exist in sheet 2": Exit Sub
  col1 = f.Column
  Set f = sh2.Rows(hrow).Find(var2.Value, , xlValues, xlWhole, , , False)
  If f Is Nothing Then MsgBox "Header " & var2 & " does not exist in sheet 2": Exit Sub
  col2 = f.Column
  
  For Each c In sh2.Range(sh2.Cells(3, col1), sh2.Cells(Rows.Count, col1).End(3))
    dic(c.Value & "|" & sh2.Cells(c.Row, col2).Value) = Empty
  Next
  
  For i = var1.Row + 1 To sh1.Cells(Rows.Count, var1.Column).End(3).Row
    cad = sh1.Cells(i, var1.Column).Value & "|" & sh1.Cells(i, var2.Column).Value
    Set rng2 = Union(sh1.Cells(i, var1.Column), sh1.Cells(i, var2.Column))
    If dic.exists(cad) Then
      If rng Is Nothing Then Set rng = rng2 Else Set rng = Union(rng, rng2)
    End If
  Next
  
  If Not rng Is Nothing Then
    Application.ScreenUpdating = False
    rng.EntireRow.Delete
  End If
End Sub

 

[AutoMation42]

You need to adjust some data in the macro. So reading your information:
---

Fit in this part:

  Set sh1 = Sheets("Sheet 1")
  Set sh2 = Sheets("Sheet 2")

---

Fit in this part:

  hrow = 2          'single header row in sheet 2

---

View attachment 55217
Fit in this part:

  Set var1 = sh1.Range("A3")    'On Sheet 1, Cell where header is (Variable1)
  Set var2 = sh1.Range("B3")    'On sheet 1, Cell where header is (Variable2)

---

On a copy of your sheet1 try this:

Sub DeleteRows()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim rng As Range, rng2 As Range, f As Range, c As Range, var1 As Range, var2 As Range
  Dim cad As String
  Dim col1 As Long, col2 As Long, i As Long, hrow As Long
  Dim dic As Object
 
  'Fit to your data
  Set sh1 = Sheets("Sheet 1")
  Set sh2 = Sheets("Sheet 2")
  Set var1 = sh1.Range("A3")    'On Sheet 1, Cell where header is (Variable1)
  Set var2 = sh1.Range("B3")    'On sheet 1, Cell where header is (Variable2)
  hrow = 2                      'single header row in sheet 2
 
  Set dic = CreateObject("Scripting.Dictionary")
 
  Set f = sh2.Rows(hrow).Find(var1.Value, , xlValues, xlWhole, , , False)
  If f Is Nothing Then MsgBox "Header " & var1 & " does not exist in sheet 2": Exit Sub
  col1 = f.Column
  Set f = sh2.Rows(hrow).Find(var2.Value, , xlValues, xlWhole, , , False)
  If f Is Nothing Then MsgBox "Header " & var2 & " does not exist in sheet 2": Exit Sub
  col2 = f.Column
 
  For Each c In sh2.Range(sh2.Cells(3, col1), sh2.Cells(Rows.Count, col1).End(3))
    dic(c.Value & "|" & sh2.Cells(c.Row, col2).Value) = Empty
  Next
 
  For i = var1.Row + 1 To sh1.Cells(Rows.Count, var1.Column).End(3).Row
    cad = sh1.Cells(i, var1.Column).Value & "|" & sh1.Cells(i, var2.Column).Value
    Set rng2 = Union(sh1.Cells(i, var1.Column), sh1.Cells(i, var2.Column))
    If dic.exists(cad) Then
      If rng Is Nothing Then Set rng = rng2 Else Set rng = Union(rng, rng2)
    End If
  Next
 
  If Not rng Is Nothing Then
    Application.ScreenUpdating = False
    rng.EntireRow.Delete
  End If
End Sub

Hi Dante, @DanteAmor

Let me start with thank you very much for the help, I was getting absolutely nowhere with google and my own coding so this is a huge step in the right direction for me. This code works as intended I just need it to be dynamic, the headers may occasionally change locations and so I tested by moving "Variable1" to "Column C" and "Variable2" to "ColumnD" and then filling fake information into the first two columns again and it no longer worked. Is it possible to use a match or something to choose the column of the correct variable? Also there was no error or anything it still worked as intended I just got the msgbox that read "Header Variable20 does not exist in sheet2" is there anything I could do to adjust it?

 

[AutoMation42]

Hi Dante, @DanteAmor

Let me start with thank you very much for the help, I was getting absolutely nowhere with google and my own coding so this is a huge step in the right direction for me. This code works as intended I just need it to be dynamic, the headers may occasionally change locations and so I tested by moving "Variable1" to "Column C" and "Variable2" to "ColumnD" and then filling fake information into the first two columns again and it no longer worked. Is it possible to use a match or something to choose the column of the correct variable? Also there was no error or anything it still worked as intended I just got the msgbox that read "Header Variable20 does not exist in sheet2" is there anything I could do to adjust it?

Sub DeleteRows()

  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim rng As Range, rng2 As Range, f As Range, c As Range, var1 As Range, var2 As Range
  Dim cad As String
  Dim col1 As Long, col2 As Long, i As Long, hrow As Long
  Dim dic As Object
 

  'Fit to your data
  Set sh1 = Sheets("Sheet 1")
  Set sh2 = Sheets("Sheet 2")
  Set var1 = sh1.Range("A3:AZ3").Find("Variable1", , xlValues, xlWhole, xlByRows, xlNext, False)    'On Sheet 1, Cell where header is (Variable1)
  Set var2 = sh1.Range("A3:AZ3").Find("Variable2", , xlValues, xlWhole, xlByRows, xlNext, False)    'On sheet 1, Cell where header is (Variable2)
  hrow = 2                      'single header row in sheet 2
 
  Set dic = CreateObject("Scripting.Dictionary")
 
  Set f = sh2.Rows(hrow).Find(var1.Value, , xlValues, xlWhole, , , False)
  If f Is Nothing Then MsgBox "Header " & var1 & " does not exist in sheet 2": Exit Sub
  col1 = f.Column
  Set f = sh2.Rows(hrow).Find(var2.Value, , xlValues, xlWhole, , , False)
  If f Is Nothing Then MsgBox "Header " & var2 & " does not exist in sheet 2": Exit Sub
  col2 = f.Column
 
  For Each c In sh2.Range(sh2.Cells(3, col1), sh2.Cells(Rows.Count, col1).End(3))
    dic(c.Value & "|" & sh2.Cells(c.Row, col2).Value) = Empty
  Next
 
  For i = var1.Row + 1 To sh1.Cells(Rows.Count, var1.Column).End(3).Row
    cad = sh1.Cells(i, var1.Column).Value & "|" & sh1.Cells(i, var2.Column).Value
    Set rng2 = Union(sh1.Cells(i, var1.Column), sh1.Cells(i, var2.Column))
    If dic.exists(cad) Then
      If rng Is Nothing Then Set rng = rng2 Else Set rng = Union(rng, rng2)
    End If
  Next
 
  If Not rng Is Nothing Then
    Application.ScreenUpdating = False
    rng.EntireRow.Delete
    End If

End Sub

I wrote a small piece and just defined the chosen column by the variable name with a .Find and it seems to be working dynamically now, I cannot express how much you helped me, I was getting absolutely nowhere by myself and you have just saved me a lot of hours trying to piece something together with various google findings. Thank you again @DanteAmor I really appreciate your help.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.