Errors when attempting to import text and check for duplicate rows in imported data

SBMa

New Member
Joined
Aug 17, 2022
Messages
8
Office Version
  1. 365
  2. 2021
  3. 2019
Platform
  1. Windows
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.

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
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

Forum statistics

Threads
1,224,822
Messages
6,181,165
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top