Remove Duplicates From Across Multipe Columns In A Single WorkSheet

[Excel Fox]

Try this

Sub ExcelFox()
        
    Dim lng As Long
    Dim wks As Worksheet
    Dim objDic As Object
    Dim var As Variant
    Dim varIndex As Variant
    Dim lngRow As Long
    Const clngSteps As Long = 100000
    
    Set objDic = CreateObject("Scripting.Dictionary")
    Set wks = Worksheets("NameOfSheetWithDuplicateValues")
    For lng = 1 To 17
        With wks
            .Range(.Cells(1, lng), .Cells(.Rows.Count, lng).End(xlUp)).RemoveDuplicates Columns:=1, Header:=xlNo
            var = .Range(.Cells(1, lng), .Cells(.Rows.Count, lng).End(xlUp)).Value2
            .Range(.Cells(1, lng), .Cells(.Rows.Count, lng).End(xlUp)).Clear
            For lngRow = 1 To UBound(var)
                objDic.Item(var(lngRow, 1)) = 0
            Next lngRow
        End With
    Next lng
    Erase var
    var = objDic.keys
    Set objDic = Nothing
    If wks.Parent.FullName <> wks.Parent.Name Then
        wks.Parent.Save
    End If
    lng = 1
    For lngRow = 1 To UBound(var) + 1 Step clngSteps
        varIndex = Evaluate(clngSteps * (lng - 1) & "+ ROW(1:" & Application.Min(UBound(var) + 1, clngSteps) & ")")
        Cells(1, lng).Resize(Application.Min(UBound(var) + 1, clngSteps)).Value = Application.Index(var, varIndex)
        lng = lng + 1
    Next lngRow
    Erase varIndex
    
End Sub

[cyphrevil]

Thank you so much for your effort. The script ran for 2 hours then crashed at below line:

Cells(1, lng).Resize(Application.Min(UBound(var) + 1, clngSteps)).Value = Application.Index(var, varIndex)

Error message said 'mismatch error'

also, the sheet has been cleared of all data - if it's of any help to you.

Kind Regards