Microsoft Excel - Please Help!! Remove Duplicates From Each Row

Asked By Rajender Prasad on 04-Dec-13 08:00 AM
hi All, 

  I have the below input data , I would need the output like below. I have to remove the duplicates from each row wise.
Excel formula or VBA anything is fine.. I am really struggling with this.

Input
52100        
70000        
70000 70000      
70000 70000 70095 70000 70095
70000        
70010 70010 70071 70000 70010
70000 70000      
70053        
70095        
70095 70095 70095    
75000 75000      
75000 75000      
75000        
75000 75000      
75000 75000      
75000 75000      
75000 75000      
75012        
12900 12900      
12900 12900 12900    
12900        
12900 12900      


Output
52100          
70000          
70000          
70000 70095        
70000          
70010 70071 70000      
70000          
70053          
70095          
70095          
75000          
75000          
75000          
75000          
75000          
75000          
75000          
75012          
12900          
12900          
12900          
12900          
Harry Boughen replied to Rajender Prasad on 04-Dec-13 11:18 PM
Hello prasad,

This code does what you ask.  It assumes that there is a header row at the top of your table.

Option Explicit
Sub Remove()

Dim rngUsed As Range
Dim row As Range
Dim cell As Range
Dim iCount As Integer, iCounta As Integer
Dim iDup As Integer
Dim arrVal() As Variant

ReDim arrVal(10)

Set rngUsed = Range("A2").CurrentRegion
Set rngUsed = rngUsed.Offset(1, 0).Resize(rngUsed.Rows.Count - 1, rngUsed.Columns.Count)
iCount = rngUsed.Columns.Count
    ReDim arrVal(10)
    iCount = 0

For Each row In rngUsed.Rows
    For Each cell In row.Cells
      If cell.Value = "" Then GoTo 100
      If iCount = 0 Then
        arrVal(iCount) = cell.Value
        iCount = iCount + 1
      Else
        iDup = 0
        For iCounta = 0 To iCount - 1
          If cell.Value = arrVal(iCounta) Then
            iDup = iDup + 1
          End If
        Next iCounta
        If iDup = 0 Then
          arrVal(iCount) = cell.Value
          iCount = iCount + 1
        End If
      End If
100:    Next cell
    row.Offset(50, 0).Value = arrVal
    ReDim arrVal(10)
    iCount = 0

Next row

End Sub

It is not pretty but it works.
Regards
Harry