The following code delete duplicate cells in a row How to modify it to remove duplicates in a column or remove duplicates in the entire sheet

Sub RemoveDuplicatesInRow()

    Dim lastRow As Long
    Dim lastCol As Long
    Dim r As Long 'row index
    Dim c As Long 'column index
    Dim i As Long

    With ActiveSheet.UsedRange
        lastRow = .Row   .Rows.Count - 1
        lastCol = .Column   .Columns.Count - 1
    End With

    For r = 1 To lastRow
        For c = 1 To lastCol
            For i = c   1 To lastCol 'change lastCol to c 2 will remove adjacent duplicates only
                If Cells(r, i) <> "" And Cells(r, i) = Cells(r, c) Then
                    Cells(r, i) = ""
                End If
            Next i
        Next c
    Next r

End Sub

CodePudding user response：

Other users have mentioned that changing the indices in your current code would give a quick solution. I agree with them, but I've also included a way to use the built-in Range.Replace method. (Source: https://docs.microsoft.com/en-us/office/vba/api/excel.range.replace) While it's often fun and challenging to come up with solutions, it's good to remember that common problems likely already have solutions built into the language.

The methodology of my code is:

1. Identify the column (range) of cells to work with.
2. Iterate through the cells in that range.
3. If an empty cell is encountered, skip it.
4. If a non-empty cell is encountered, replace all cells in the range with that same value with an empty string (using the .Replace method).
5. Repopulate the original value to the first instance of the cell.

Private Sub MakeColumnUnique(ColumnRange As Range)

    Dim ReplaceValue As String, ReplaceRange As Range
    Dim Cell As Variant
    For Each Cell In ColumnRange.Cells
    
        ' The value to check for duplicates of
        ReplaceValue = Cell.Value
        
        ' If the cell is empty, skip it
        If ReplaceValue <> "" Then
            
            ' Replace the duplicates
            ColumnRange.Replace What:=Cell.Value, Replacement:=""
            
            ' Repopulate
            Cell.Value = ReplaceValue
        
        End If

    Next Cell

End Sub

The reason we re-populate the cell is because the .Replace method replaces all instances of the What argument with the Replacement argument. If you wanted, you could alter the Range in each iteration to exclude the current value, but I believe (but haven't tested) that this would both add more lines of code and be slower.

CodePudding user response：

I have modified to the following and to remove the 2nd duplicate in a column and it works

Sub RemoveDuplicatesInRow()

    Dim lastRow As Long
    Dim lastCol As Long
    Dim r As Long 'row index
    Dim c As Long 'column index
    Dim i As Long

    With ActiveSheet.UsedRange
        lastRow = .Row   .Rows.Count - 1
        lastCol = .Column   .Columns.Count - 1
    End With

    For r = 1 To lastRow
        For c = 1 To lastCol
            For i = r   1 To lastRow
                If Cells(i, c) <> "" And Cells(i, c) = Cells(r, c) Then
                    Cells(i, c) = ""
                End If
            Next i
        Next c
    Next r

End Sub