Remove duplicate rows in Excel from a particular sheet

Question

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

Your code contains exactly one line that does the copying: ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1). It needs to be replaced with a function that loops through the UsedRange row by row, determines if that row should be copied, and then either copy/pastes or moves to the next row without action. You will need criteria by which to decide if the row is a duplicate. — Variatus
– Variatus, Commented Mar 6, 2021 at 0:37
You should clarify what remove duplicate rows in your case means. If it means to remove the headers or the first n rows that are the same in all the .csv files, then it is handled in one way, but if it means that the 'data' can also have duplicates, it is handled another way. In the first case, you could e.g. replace ActiveSheet.UsedRange.Copy with ActiveSheet.UsedRange.Resize(ActiveSheet.UsedRange.Rows.Count - n).Offset(n).Copy. Also, you should tell us if the .csv files have the same number of columns and if maybe rather one or a few columns are to be checked if they are the same. — VBasic2008
– VBasic2008, Commented Mar 6, 2021 at 6:33
VBasics2008 - The CSVs have the exact number of columns, and yes, I actually want to remove all the headers, except the one at the top. — Eddie
– Eddie, Commented Mar 6, 2021 at 9:44

Dave · Accepted Answer · 2021-03-06 12:03:04Z

2

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://learn.microsoft.com/en-us/office/vba/api/excel.range.removeduplicates

edited Mar 6, 2021 at 12:03

answered Mar 6, 2021 at 1:47

Dave

715 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

Gass Over a year ago

Interesting I didn't know about this.

VBasic2008 Over a year ago

This will remove the rows where only A and C are duplicates, but B can be anything. You should either explain this or correct it to ...Array(1, 2, 3)... which will remove the rows where A, B, and C are duplicates. It is similar to e.g. Range("A1", "A3") and Range("A1,A3") i.e. A1,A2,A3 (3 cells) and A1,A3 (2 cells).

VBasic2008 · Accepted Answer · 2021-03-06 11:39:36Z

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

VBasic2008 - Could you please help me convert the imported data to an official excel table? I tried making another Sub and calling the sub from your code, but it didn't work.
Before dwb.Save you could e.g. use the one-liner: dcell.Worksheet.ListObjects.Add(xlSrcRange, dcell.CurrentRegion, , xlYes).Name = "Table1".

Collectives™ on Stack Overflow

Remove duplicate rows in Excel from a particular sheet

2 Answers 2

2 Comments

Do Not Import Headers After the First Imported Worksheet

3 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

2 Comments

Do Not Import Headers After the First Imported Worksheet

3 Comments

Your Answer

Sign up or log in

Post as a guest

Related