Remove duplicate rows in Excel from a particular sheet

user_15339796 0
Viewed 105

Thanks in advance for helping!

I am currently using the below code to populate multiple .csv files into one sheet and then hide the sheet. The help I need is to remove duplicate rows from that sheet. Can it be incorporated into this code? Thank you!

Sub ImportCSVsWithReference()
'UpdatedforSPSS
    Dim xSht  As Worksheet
    Dim xWb As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    On Error GoTo ErrHandler
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select the folder with the csv files [File Picker]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    Set xSht = Sheets.Add
    ActiveSheet.Name = "ImportedData"
    Worksheets("ImportedData").Visible = False
    Application.ScreenUpdating = False
    xFile = Dir(xStrPath & "\" & "*.csv")
    Do While xFile <> ""
        Set xWb = Workbooks.Open(xStrPath & "\" & xFile)
        ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
        xWb.Close False
        xFile = Dir
    Loop
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox "Encountered an error. Try again", , "Error"
End Sub
vba excel
2 Answers

There is actually a built-in function to remove duplicates from a range. It is called RemoveDuplicates...

Let's look at an example. I assume here that -

  • The table has 3 columns
  • The table has 100 rows
  • The table does not have a header line

Then the code to remove duplicates will look something like:

ActiveSheet.Range("A1:C100").RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlNo

See the docs at https://docs.microsoft.com/en-us/office/vba/api/excel.range.removeduplicates

user_152501990

Do Not Import Headers After the First Imported Worksheet

  • s - Source (read from)
  • d - Destination (written to)

The Code

Option Explicit

Sub ImportCSVsWithReference()
    Const ProcName As String = "ImportCSVsWithReference"
    'On Error GoTo clearError
    
    Const WorksheetName As String = "ImportedData"
    Const HeaderRows As Long = 1

    ' Get Folder Path.
    Dim FolderPath As String
    Dim fd As Office.FileDialog
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd
        .AllowMultiSelect = False
        '.InitialFileName = "C:\Test" ' consider using this
        .Title = "Select the folder with the csv files [File Picker]"
        If .Show = -1 Then
            FolderPath = .SelectedItems(1)
        Else
            GoTo ProcExit ' Exit Sub
        End If
    End With
    
    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
     
    Application.ScreenUpdating = False
    
    ' Define Destination Worksheet (delete existing, add new).
    On Error Resume Next
    Dim dws As Worksheet: Set dws = dwb.Worksheets(WorksheetName)
    On Error GoTo 0
    If Not dws Is Nothing Then ' it already exists
        Application.DisplayAlerts = False
        dws.Delete ' delete without confirmation
        Application.DisplayAlerts = True
    End If
    Set dws = dwb.Worksheets.Add(After:=dwb.Sheets(dwb.Sheets.Count)) ' Sheets!
    dws.Name = WorksheetName
    dws.Visible = xlSheetHidden ' xlSheetVeryHidden (a 'tougher' option)
    
    ' Define Destination Cell.
    Dim dCell As Range: Set dCell = dws.Range("A1")
    
    ' Copy data from Source Worksheets to Destination Worksheet.
    Dim FileName As String: FileName = Dir(FolderPath & "\" & "*.csv")
    Dim sws As Worksheet
    Dim srg As Range
    Dim swsCount As Long
    Do While FileName <> ""
        ' There is only one worksheet in a csv file (the first):
        Set sws = Workbooks.Open(FolderPath & "\" & FileName).Worksheets(1)
        Set srg = sws.UsedRange
        If srg.Rows.Count > HeaderRows Then
            swsCount = swsCount + 1
            If swsCount > 1 Then  ' headers for the first worksheet only
               Set srg = srg.Resize(srg.Rows.Count - HeaderRows) _
                   .Offset(HeaderRows)
            End If
            dCell.Resize(srg.Rows.Count, srg.Columns.Count).Value _
                = srg.Value
            Set dCell = dCell.Offset(srg.Rows.Count)
        End If
        sws.Parent.Close False ' the workbook is the 'parent' of the worksheet
        FileName = Dir
    Loop
    'dwb.save
    
ProcExit:
    
    If Application.ScreenUpdating = False Then
        Application.ScreenUpdating = True
    End If
    
    ' Inform.
    Select Case swsCount
    Case 0
        MsgBox "No worksheet imported.", vbExclamation, "Fail?"
    Case 1
        MsgBox "1 worksheet imported.", vbInformation, "Success"
    Case Else
        MsgBox swsCount & " worksheets imported.", vbInformation, "Success"
    End Select
    
    Exit Sub

clearError:
    MsgBox "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "        " & Err.Description
    Resume ProcExit
End Sub
user_98140690
Related