Share via

VBA Code to Identify Duplicate Row Between Datasets

Anonymous
2024-05-21T13:55:10+00:00

Good morning,

I am trying to figure out how to write this VBA code and was hoping for some assistance. The intended goal for this is to prevent a dataset with duplicate rows from being imported.

Prior to the below portion of the code being imported, I am trying to compare the data and present an error a duplicate is found. I found a code online and was trying to adapt it to my scenario below.

sh2 is the sheet containing the data to be uploaded, sh is the sheet in which data will be uploaded. This is just a portion of the code as it is a huge module.

Thanks,


Dim r1 as range, vlu as string, lc as long

lc = 24

With CreateObject("scripting.dictionary")

   For Each r1 in sh2.range("A2", sh2.range("A" & sh2.Rows.Count).End(xlUp))

        vlu = Join(Application.Index(r1.resize(,cl).Value, 1, 0), "|")

        vlu = Empty

    Next cl

          For Each r1 in sh.range("A2", sh.range("A" & sh.Rows.Count).End(xlUp))

                vlu = Join(Application.Index(r1.Resize(,lc).Value,1,0),"|")

                      If .exists(vlu) Then

                           MsgBox "Error EX01012" , "Upload Error EX01012"

                 OpenBook.Application.CutCopyMode = False

                 OpenBook.Close False

                 Application.ScreenUpdating = True

            End If

Exit Sub

Next r1

End With

When I run the code, the MsgBox keeps appearing even though the data does not have duplicates between the two datasets. I am sure I'm doing something wrong but can't figure it out.

Thanks,

Adam

Microsoft 365 and Office | Excel | For business | Windows

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments No comments

Answer accepted by question author

HansV 462.6K Reputation points
2024-05-21T14:14:06+00:00

Does this work better?

    Dim r1 As Range, vlu As String, lc As Long
    Dim dic As Object
    Set dic = CreateObject(Class:="Scripting.Dictionary")
    lc = 24

    For Each r1 In sh2.Range("A2", sh2.Range("A" & sh2.Rows.Count).End(xlUp))
        vlu = Join(Application.Index(r1.Resize(, lc).Value, 1, 0), "|")
        dic(vlu) = 1
    Next r1

    For Each r1 In sh.Range("A2", sh.Range("A" & sh.Rows.Count).End(xlUp))
        vlu = Join(Application.Index(r1.Resize(, lc).Value, 1, 0), "|")
        If dic.Exists(vlu) Then
            MsgBox "Error EX01012", "Upload Error EX01012"
            Application.CutCopyMode = False
            OpenBook.Close SaveChanges:=False
            Application.ScreenUpdating = True
            Exit Sub
        End If
    Next r1

Was this answer helpful?

1 person found this answer helpful.
0 comments No comments

3 additional answers

Sort by: Most helpful
  1. Anonymous
    2024-05-23T09:03:24+00:00

    Good morning!

    Great news! The code you suggested DOES work! I realized I had misnamed the dimensions for the worksheets earlier in my code so that solved the issue at hand.

    Thank you so much!!

    Was this answer helpful?

    0 comments No comments
  2. HansV 462.6K Reputation points
    2024-05-21T18:13:52+00:00

    I understand that you cannot make a sample workbook available, but I'm afraid I cannot solve the problem without seeing the data.

    Was this answer helpful?

    0 comments No comments
  3. Anonymous
    2024-05-21T17:20:43+00:00

    Hmm that doesn't seem to work, though I enjoy it being much cleaner. I've double checked the values in both datasets, and there is no overlap, yet the results are saying there is.

    Is there another way to go about this? Perhaps there's a way to join values at the end of the rows in each workbook, conduct something akin to an xmatch to find duplicates (if present), and then remove the column? I don't want the formulas in there because the size of the files is already pretty decent.

    I wish I could upload examples, but due to confidentiality I cannot.

    Thanks,

    Adam

    Was this answer helpful?

    0 comments No comments