Hi Vijay,

Please do not quote the entire post unless it is relevant.
You may also try this code.

Code:
Option Explicit

Sub kTest()
    
    Dim ResultCol           As Long
    Dim Cols2Compare        As String
    Dim d, i As Long, Dic() As Object
    Dim x, j As Long, UB    As Long
    
    
    Cols2Compare = Application.InputBox("Enter the columns to compare", "Compare Columns", "1,3,5,6", Type:=2)
    
    If Cols2Compare = "False" Or Cols2Compare = "" Then Exit Sub
    
    ResultCol = Application.InputBox("Enter the result column", "Compare Columns", 10, Type:=1)
    
    If ResultCol = 0 Then Exit Sub
    
    x = Split(Cols2Compare, ",")
    UB = UBound(x)
    If UB < 1 Then
        MsgBox "Minimum 2 columns required", vbInformation
        Exit Sub
    End If
    
    For i = 0 To UB
        ReDim Preserve Dic(i)
        Set Dic(i) = CreateObject("scripting.dictionary")
        Dic(i).comparemode = 1
    Next
    
    d = Range("a1").CurrentRegion.Value2
    
    For j = 0 To UB
        For i = 1 To UBound(d, 1) 'replace 1 with 2 if the data have column headers
            Select Case j
                Case 0
                    If Len(d(i, x(j))) Then
                        Dic(0).Item(d(i, x(j))) = True
                    End If
                Case Else
                    If Dic(j - 1).exists(d(i, x(j))) Then
                        Dic(j).Item(d(i, x(j))) = True
                    End If
            End Select
        Next
    Next
    
    If Dic(UB).Count Then
        j = Dic(UB).Count
        Cells(1, ResultCol) = "Result"
        Cells(2, ResultCol).Resize(j) = Application.Transpose(Dic(UB).keys)
        Cells(2, ResultCol).Resize(j).Sort Cells(2, ResultCol), 1
    End If
    
End Sub