Currently getting a runtime error when copying over the data in the for loop checking for duplicates
I am attempting to check all rows for duplicate rows in the imported text. Then copy the entire imported text to the bottom of the original sheet from column c.
I am attempting to check all rows for duplicate rows in the imported text. Then copy the entire imported text to the bottom of the original sheet from column c.
VBA Code:
Sub ImportText1()
' Tester !!!! Tester
' ImportText1 Macro
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
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 = 2 To dlr
DictDuplicates.Add .Cells(i, 7), i
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:M" & lImpR).Value
End With
wbTextImport.Close False
End If
' Now you can work on the array
For i = 2 To UBound(arrData) ' I'm assuming the data copied has headers, if not, change 2 for 1
If DictDuplicates.Exists(arrData(i, 1) & """__""" & arrData(i, 2)) Then
'If the concatenated data exists on the dictionary
MsgBox "Duplicates found, please check data you are attempting to copy"
Exit For
Else
'If it doesn't import worksheet from a2 to last cells with data on this worksheet from lr in c
With wbTextImport.Worksheets(1)
.Range("A2", .Cells(lImpR, lImpC)).Copy wsMaster.Range("C" & lr)
End With
MsgBox "Success"
End If
Next i
Application.ScreenUpdating = True
'
End Sub