How to Delete Duplicate Cells per Row

[NicoleSager]

Hello everyone!

I am working on a file that has about 1000 rows. Column A is a Unique ID (Contact ID) and each column afterward is an Entity ID that will be tagged/linked to the Unique ID in column A. There are cases where there are duplicate Entity IDs per Unique ID and I need to remove the duplicate except the first instance. 

I found a macro code online however it looks to delete ALL duplicates not leaving the first instance. Could someone help me with fixing this? Or maybe there is another way to do this?

Code:

Sub DeleteDuplicates()

Dim MyRange As Range, rw As Range
Dim MyArray() As Variant
Dim aryEntry() As String, aryFilter() As String
Dim MyFilter As String, MyIndex As Integer
Dim i As Integer

Set MyRange = ActiveSheet.UsedRange
LastColumn = MyRange.Columns.Count

ReDim aryEntry(1 To LastColumn)
ReDim aryFilter(1 To 1)

For Each rw In MyRange.Rows
    'Load row into the output array
    MyArray = rw.Cells
    
    'Combines cell values and column index in a single array index
    For i = 1 To UBound(MyArray, 2)
        aryEntry(i) = MyArray(1, i) & " " & i
    Next i

    For i = 1 To UBound(MyArray, 2)
        'Filter only on the cell value, not the index
        MyFilter = Left(aryEntry(i), InStr(1, aryEntry(i), " ") - 1)
        
        'Loads duplicate cell values (with column index) into an array
        aryFilter = Filter(aryEntry, MyFilter)
        
        'If more than one entry exists, it is a duplicate
        If UBound(aryFilter) > 0 Then
            
            'Separates index from cell value
            MyIndex = Right(aryEntry(i), Len(aryEntry(i)) - InStr(1, aryEntry(i), " "))
            
            'Clear all duplicate entries (but not original)
            For j = 1 To UBound(aryFilter)
                MyArray(1, MyIndex) = ""
            Next j
        End If
    Next i
    
    'Returns cleaned array to the worksheet
    rw.Cells = MyArray
Next rw

'Deletes all blank cells in the used range
MyRange.SpecialCells(xlCellTypeBlanks).Delete (xlShiftToLeft)

End Sub

Thank you!!

[#2]

@NicoleSager 

To delete duplicate cells per row, you can use a combination of Excel functions and tools. Here are the steps:

1. Select the range of cells that you want to check for duplicates.
2. Click on the "Conditional Formatting" option in the "Home" tab of the ribbon.
3. Select "Highlight Cells Rules" and then "Duplicate Values" from the dropdown menu.
4. In the "Duplicate Values" dialog box, select the "Duplicate" option and choose a formatting style for the duplicate cells. Click OK.
5. You will now see the duplicate cells highlighted in your selected range.
6. Select the entire range again and go to the "Data" tab on the ribbon.
7. Click on the "Remove Duplicates" option in the "Data Tools" group.
8. In the "Remove Duplicates" dialog box, make sure that only the columns you want to check for duplicates are selected. Click OK.
9. You will now see a prompt asking you to confirm the deletion of the duplicate cells. Click OK to remove them.

This should delete all duplicate cells per row within the selected range.

[#3 · Accepted solution]

@NicoleSager 

An alternative could be Power Query. In the attached file you can add data to the blue dynamic table. Then you can click in any cell of the green table and right-click with the mouse and select refresh to update the green result table.

[#4]

Oh this seems to do the job, thank you so much! Would you mind explaining how you built it? I would love to be able to utilize this going forward.

Thanks again!

[#5]

Go to Data >>> Data Tools>>>>>Remove Duplicates>>>Check "My data has headers'>>>Tick the header to run duplicate on

[#6]

That will remove duplicates by column not row unfortunately

[#7]

@NicoleSager 

You can start the Power Query Editor as shown in the screenshot. Power Query -> Editor starten (start editor in english Excel). 

In the Power Query Editor you can follow the steps starting with "Quelle" or "source" in english. You can select any step you want. Currently the step "Quelle" (source) is selected. All the buttons and applied steps are shown in your language when you open the file. On the right side i've indicated the gear icons with blue dashes. You can click on a gear icon to view which rule has been applied to create the change of the data.

[#8]

Ohh I understand, thank you so so much for the help!! I will take a look at those steps and try to duplicate from the start with a new sheet.

I hope you have a great rest of your day! :D

[#9]

@NicoleSager 

You are welcome. I've just noticed that you work with Office 365. An alternative to Power Query could be a dynamic arrayformula.  I hope you have a great rest of your day as well!

=LET(unique,BYROW(B2:E10,LAMBDA(row,TEXTJOIN(",",,TOROW(UNIQUE(TRANSPOSE(row)))))),HSTACK(A2:A10,IFNA(DROP(REDUCE("",unique,LAMBDA(ini,arr,VSTACK(ini,TEXTSPLIT(arr,",")))),1),"")))

:D