Check and Remove duplicates Horizontally (Within ROW)

[winmaxservices1]

Hi,

I have a data in sheet1. Column A is Serial number and data starts from Column B till the end.

I want to remove the duplicate values within a row. and paste a data (Without duplicates) in a new sheet2

Note : - we will be adding data in rows and columns from time to time.

Please refer attachment.

[JasperD]

Try this:

Sub excelforum()
Dim unique$
Sheet2.Cells.ClearContents
For Each Row In Sheet1.Range("A1:A" & Sheet1.Cells(Rows.Count, 1).End(xlUp).Row)
    For Each Column In Sheet1.Range(Cells(Row, 2), Sheet1.Cells(Row, Cells(Row, Columns.Count).End(xlToLeft).Column))
        If Not Column = vbNullString And InStr(unique, Column) = 0 Then
        unique = unique & Column & ","
        Sheet2.Cells(Row, Sheet2.Cells(Row, Columns.Count).End(xlToLeft).Column).Offset(0, 1) = Column
        End If
    Next Column
unique = vbnulstring
Next Row

End Sub

[winmaxservices1]

it shows error in following line

If Not Column = vbNullString And InStr(unique, Column) = 0 Then

[JasperD]

Weird, worked for me.
but I have to admit I used lazy coding.

Adjust as follows:

Sub excelforum()
Dim unique$, rw As Range, col As Range
Sheet2.Cells.ClearContents
For Each rw In Sheet1.Range("A1:A" & Sheet1.Cells(Rows.Count, 1).End(xlUp).Row)
    For Each col In Sheet1.Range(Cells(rw.Row, 2), Sheet1.Cells(rw.Row, Sheet1.Cells(rw.Row, Columns.Count).End(xlToLeft).Column))
        If Not col = vbNullString And InStr(unique, col) = 0 Then
        unique = unique & col & ","
        Sheet2.Cells(rw.Row, Sheet2.Cells(rw.Row, Columns.Count).End(xlToLeft).Column).Offset(0, 1) = col
        End If
    Next col
unique = vbnulstring
Next rw

End Sub