VBA Program to Compare 4 Columns in Excel (Required)

[Admin]

Hi Vijay,

Please do not quote the entire post unless it is relevant.
You may also try this 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

[vijaysram]

Thank you so much for your kind assistance..It helps me to save a lot of time :-)