0

I have lots of employees in a list showing what courses they’ve done. Column A is their customer ID, column M is the course they’ve completed.

How do I delete a row if there is a duplicate course record for each ID seeing as some employees will have done the same course name.

1
  • Create a new column that is combination CustomerID+CourseID then remove duplicates. Commented Aug 23, 2020 at 21:02

2 Answers 2

2

Use the Remove Duplicates function in Excel, simply highlight the 2 columns you want to eliminate duplicates values of. Quick example below:

enter image description here

Then select the 2 columns you want to check for duplicate values of in the dialogue box (make sure to uncheck all columns not relevant).

My example output:

enter image description here

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

Comments

0

Remove Duplicate Rows i.e. Hide or Delete

  • The 1st Sub shows how to use the 2nd, main sub (removeDuplicateRows).
  • The remaining Subs are being called be the main sub (also necessary).
  • Only when done testing, go from hiding to deleting.

The Code

Option Explicit

Sub testRemoveDuplicateRows()
    
    Const wsName As String = "Sheet1"
    Const LastRowColumnID As Variant = "A" ' e.g. 1 or "A"
    Const FirstRow As Long = 2
    Dim ColumnIDs As Variant: ColumnIDs = Array(1, "M")
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    
    ' Hide duplicate rows.
    removeDuplicateRows ws, ColumnIDs, LastRowColumnID, FirstRow, True

    ' Delete duplicate rows.
    'removeDuplicateRows ws, ColumnIDs, LastRowColumnID, FirstRow

End Sub

Sub removeDuplicateRows(Sheet As Worksheet, _
                        ColumnIDs As Variant, _
                        Optional LastRowColumnID As Variant = 1, _
                        Optional FirstRow As Long = 1, _
                        Optional hideOnly As Boolean = False)

    ' Write values of columns to jagged array.
    Dim Cols As Variant
    getColumns Cols, Sheet, ColumnIDs, LastRowColumnID, FirstRow
    
    ' Join values of arrays in jagged array.
    Dim Data As Variant: joinColumns Data, Cols
    
    ' Write duplicate row numbers to array.
    Dim RowOffset As Long: RowOffset = FirstRow - 1 ' 1 = ubound(Data)
    Dim DupeRows As Variant
    collectDuplicateRows DupeRows, Data, RowOffset
    
    ' Hide or delete duplicate rows.
    If hideOnly Then
        hideRows Sheet, DupeRows
    Else
        deleteRows Sheet, DupeRows
    End If
      
End Sub

Sub getColumns(ByRef Data As Variant, _
               Sheet As Worksheet, _
               ColumnIDs As Variant, _
               Optional LastRowColumnID As Variant = 1, _
               Optional FirstRow As Long = 1)
    
    Dim ubc As Long: ubc = UBound(ColumnIDs)
    If ubc = -1 Then Exit Sub
    
    Dim rng As Range: getColumnRange rng, Sheet, LastRowColumnID, FirstRow
    If rng Is Nothing Then Exit Sub
    
    ReDim Data(ubc): getColumnFromColumnRange Data(0), rng
    
    If ubc > 0 Then GoSub getRemainingColumns
     
    Exit Sub

getRemainingColumns:
    Dim j As Long
    For j = 1 To ubc
        getColumnFromColumnRange Data(j), _
          rng.Offset(, Sheet.Columns(ColumnIDs(j)).Column - rng.Column)
    Next j
    Return

End Sub

Sub getColumnRange(ByRef ColumnRange As Range, _
                   Sheet As Worksheet, _
                   Optional ColumnID As Variant = 1, _
                   Optional FirstRow As Long = 1)
    
    Set ColumnRange = Nothing
    
    Dim rng As Range
    Set rng = Sheet.Columns(ColumnID).Find("*", , xlValues, , , xlPrevious)
    
    If rng Is Nothing Then Exit Sub
    If rng.Row < FirstRow Then Exit Sub
    
    Set ColumnRange = Sheet.Range(Sheet.Cells(FirstRow, ColumnID), rng)

End Sub
                    
Sub getColumnFromColumnRange(ByRef Data As Variant, _
                             ColumnRange As Range)
    If ColumnRange Is Nothing Then Exit Sub
    If ColumnRange.Cells.Count > 1 Then
        Data = ColumnRange.Value
    Else
        ReDim Data(1 To 1, 1 To 1): Data(1, 1) = ColumnRange.Value
    End If
End Sub
                             
Sub joinColumns(ByRef Data As Variant, _
                ColumnsArray As Variant, _
                Optional Delimiter As String = "|||")
    
    Data = ColumnsArray(0)
    If UBound(ColumnsArray) = 0 Then Exit Sub
    
    Dim ubr As Long: ubr = UBound(Data)
    Dim j As Long, i As Long
    For j = 1 To UBound(ColumnsArray)
        For i = 1 To ubr
            Data(i, 1) = Data(i, 1) & Delimiter & ColumnsArray(j)(i, 1)
        Next i
    Next j
    
End Sub
                
Sub collectDuplicateRows(ByRef DupeRows As Variant, _
                         Data As Variant, _
                         Optional RowOffset As Long = 0, _
                         Optional DupeRowsFirstIndex As Long = 0)
    
    Dim ub As Long: ub = UBound(Data)
    If ub < 2 Then Exit Sub
    
    Dim i As Long, k As Long, m As Long: m = DupeRowsFirstIndex - 1
    ReDim DupeRows(DupeRowsFirstIndex To ub + DupeRowsFirstIndex - 2)
    
    For i = 1 To ub - 1
        For k = i + 1 To ub
            If Data(k, 1) = Data(i, 1) Then
                m = m + 1
                DupeRows(m) = k + RowOffset
                Exit For
            End If
        Next k
    Next i
    
    If m > DupeRowsFirstIndex - 1 Then
        ReDim Preserve DupeRows(DupeRowsFirstIndex To m)
    Else
        DupeRows = Empty
    End If
    
End Sub

Sub deleteRows(Sheet As Worksheet, _
               RowNumbers As Variant)
    
    Dim rng As Range: Set rng = Sheet.Rows(RowNumbers(LBound(RowNumbers)))
    If UBound(RowNumbers) > LBound(RowNumbers) Then GoSub collectRemainingRows
    
    If Not rng Is Nothing Then rng.EntireRow.Delete
    
    Exit Sub
    
collectRemainingRows:
    Dim j As Long
    For j = LBound(RowNumbers) + 1 To UBound(RowNumbers)
        Set rng = Union(rng, Sheet.Rows(RowNumbers(j)))
    Next j
    Return
    
End Sub

Sub hideRows(Sheet As Worksheet, _
             RowNumbers As Variant)
    
    Dim rng As Range: Set rng = Sheet.Rows(RowNumbers(LBound(RowNumbers)))
    If UBound(RowNumbers) > LBound(RowNumbers) Then GoSub collectRemainingRows
    
    If Not rng Is Nothing Then rng.EntireRow.Hidden = True
    
    Exit Sub
    
collectRemainingRows:
    Dim j As Long
    For j = LBound(RowNumbers) + 1 To UBound(RowNumbers)
        Set rng = Union(rng, Sheet.Rows(RowNumbers(j)))
    Next j
    Return
    
End Sub

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.