I am attempting to check data imported from a sheet for duplicates with my current sheet.
I've added some of my current sheets data to a dictionary.
I then try to loop through an array of the imported data and check for duplicates in my using the array as a key
This isn't working and dictionary.exists always returns true
I know for a fact that the dictionary contains and have tested it with data that definitely has duplicates when it should be returning false.
two ways ive tried to compare the dictionary and array are
Full Code Here
I've added some of my current sheets data to a dictionary.
I then try to loop through an array of the imported data and check for duplicates in my using the array as a key
This isn't working and dictionary.exists always returns true
I know for a fact that the dictionary contains and have tested it with data that definitely has duplicates when it should be returning false.
two ways ive tried to compare the dictionary and array are
VBA Code:
'If DictDuplicates.Item(CStr(arrData(i, 1))) = arrData(i, 4) Then
If DictDuplicates.Exists(arrData(i, 1) & """__""" & arrData(i, 4)) Then
Full Code Here
VBA Code:
Sub DuplicateCheckerImport()
'
' DuplicateCheckerImport Macro
' Tester !!!! Tester
Dim fileToOpen As Variant
Dim fileFilterPattern As String
Dim wsMaster As Worksheet
Dim wbTextImport As Workbook
Dim dlr As Long
Dim lr As Long
Dim lImpC As Long
Dim lImpR As Long
Dim DictDuplicates As Object
Dim countMatch As Long
Set DictDuplicates = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
Set wsMaster = ThisWorkbook.Worksheets("Asset Upload Data 2022")
With wsMaster
lr = .Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
dlr = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To dlr
' adds time and asset name key/value pair
DictDuplicates.Add .Cells(i, 6).Text, .Cells(i, 3).Text
Next i
End With
fileFilterPattern = "Microsoft Excel Workbooks (*.xls*),*.xls*"
fileToOpen = Application.GetOpenFilename(fileFilterPattern)
' open workbook
If fileToOpen = False Then
' input Cancelled
MsgBox "No file Selected."
Else
Workbooks.OpenText _
Filename:=fileToOpen, _
StartRow:=2, _
DataType:=xlDelimited, _
Tab:=True
Set wbTextImport = ActiveWorkbook
' limpC last column with data
' limmpR last row with data
With wbTextImport.Worksheets(1)
lImpC = .Cells(1, .Columns.Count).End(xlToLeft).Column
lImpR = .Cells(Rows.Count, 1).End(xlUp).Row
arrData = .Range("A1:D" & lImpR).Value
End With
End If
'Dim y As Variant
'For Each y In arrData
' Debug.Print y
'Next
countMatch = 0
' Now you can work on the array
For i = LBound(arrData) To UBound(arrData) ' I'm assuming the data copied has headers, if not, change 2 for 1
' Debug.Print DictDuplicates.Exists(arrData(i, 1)) & "fuu"
' If DictDuplicates.Item(CStr(arrData(i, 1))) = arrData(i, 4) Then
If DictDuplicates.Exists(arrData(i, 1) & """__""" & arrData(i, 4)) Then
' If the concatenated data exists on the dictionary
MsgBox "Duplicates found, please check data you are attempting to copy"
countMatch = countMatch + 1
Exit For
Else
' If it doesn't import worksheet from a2 to last cells with data on this worksheet from lr in c
If countMatch = 0 And i = UBound(arrData) Then
With wbTextImport.Worksheets(1)
.Range("A2", .Cells(lImpR, lImpC)).Copy wsMaster.Range("C" & lr)
End With
wbTextImport.Close False
End If
End If
Next i
Application.ScreenUpdating = True
'
End Sub