vsbabu.org

Remove Duplicates in Excel

Option Explicit
' Macros to remove duplicate values from columns
' Useful to take the eye-sore out of sub-totals
' Assumes sorted sheet
' Vattekkat Satheesh Babu

' Removes from one colmn selection . Does not permit multi-column selects
Sub RemoveDuplicates()
    Dim oRange As Object
    Dim oP_Value As Object
    Dim r_counter As Integer
    r_counter = 0
    Set oRange = Selection
    If oRange.Columns.Count > 1 Then
        MsgBox "You cannot carry out this command on multiple columns"
    End If
    Set oP_Value = oRange.Cells(1)
    For r_counter = 2 To oRange.Count
        If oP_Value.Cells(1).Value = oRange.Cells(r_counter).Value Then
           oRange.Cells(r_counter).ClearContents
         Else
           Set oP_Value = oRange.Cells(r_counter)
         End If
    Next r_counter
    Exit Sub
End Sub

' Tries on a multi-column group
' Be careful NOT to include your summing columns !
Sub GroupWithoutRepeats()
    Dim oRange As Object
    Dim oP_Value As Object
    Dim r_counter As Integer
    Dim c_counter As Integer
    Dim wc_dummy As Integer
    Dim num_cols As Integer
    r_counter = 0
    c_counter = 0
    Set oRange = Selection
    num_cols = oRange.Columns.Count
    If num_cols = 1 Then
      RemoveDuplicates
      Exit Sub
    End If
    Set oP_Value = oRange.Cells(1 + oRange.Count, num_cols)
    ' this loops through the rows
    For r_counter = 2 To oRange.Count
        ' in each row , check each column
        For c_counter = 1 To num_cols
         If oP_Value.Cells(1, c_counter).Value = oRange.Cells(r_counter, c_counter).Value Then
           oRange.Cells(r_counter, c_counter).ClearContents
         Else
           oP_Value.Cells(1, c_counter).Value = oRange.Cells(r_counter, c_counter).Value
           For wc_dummy = c_counter + 1 To num_cols
            oP_Value.Cells(1, wc_dummy).Value = "abracadabra"
            ' Hopefully , no cell will have the value abracadabra !
           Next wc_dummy
         End If
        Next c_counter
    Next r_counter
    Exit Sub
End Sub