Remove Duplicates within each row

[Angiec50]

I have a spreadsheet that has the user name in one column and then their relevant applications in the adjoining columns ie.

Column A Column B Column C Column D
User Name App1 App2 App3 etc
HP0505 Word Silverlight Lotus Notes etc
HP0606 Winzip Winzip Word

My task is to remove any duplicate apps for each user. I.e. to run through each row and remove any duplicate items.

Can anyone help with some code please

Thank in advance for your help

 

[VoG]

Try with a copy of your sheet

Sub Test2()
Dim LR As Long, LC As Long, i As Long, j As Long
LR = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
For i = 2 To LR
    LC = Rows(i).Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
    For j = LC To 3 Step -1
        If WorksheetFunction.CountIf(Rows(i), Cells(i, j).Value) > 1 Then Cells(i, j).Delete shift:=xlShiftToLeft
    Next j
Next i
End Sub

 

[Angiec50]

Thanks this works GREAT