.
My fault ... your explanation is accurate.
Try this and let me know :
Code:
Option Explicit
Sub DeleteDupsInRows()
Dim DataRow As Variant
Dim Dict As Object
Dim j As Long
Dim k As Long
Dim Key As String
Dim lastCol As Long
Dim lastRow As Long
Dim Rng As Range
Dim Wks As Worksheet
For Each sht In ActiveWorkbook.Worksheets
Set Wks = ActiveSheet
Set Rng = Wks.Range("A1")
lastCol = Wks.Cells.Find("*", , xlValues, xlWhole, xlByColumns, xlPrevious, False, False, False).Column
lastRow = Wks.Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False, False, False).Row
If lastRow < Rng.Row Then Exit Sub
Set Rng = Rng.Resize(lastRow - Rng.Row + 1, lastCol - Rng.Column + 1)
Set Dict = CreateObject("Scripting.Dictionary")
Dict.CompareMode = vbTextCompare
For j = 1 To Rng.Rows.Count
DataRow = Rng.Rows(j).Value
For k = 1 To UBound(DataRow, 2)
Key = Trim(DataRow(1, k))
If Key <> "" Then
If Not Dict.Exists(Key) Then
Dict.Add Key, 1
End If
End If
Next k
Rng.Rows(j).Value = Empty
Rng.Rows(j).Resize(1, Dict.Count).Value = Dict.Keys
Dict.RemoveAll
Next j
Next
End Sub
Bookmarks