VBA Program to Compare 4 Columns in Excel (Required)

[Excel Fox]

So if a value is found on all 4 columns, on which row in the 5th column do we write the output? And which column do we use to consider as base comparison value? Column A?

[vijaysram]

So if a value is found on all 4 columns, on which row in the 5th column do we write the output? And which column do we use to consider as base comparison value? Column A?

Hi

The Macro should ask us for the input of the column name which we need to put the result. The result can be displayed as per sort : smallest to largest so it will be easy. You may consider base comparison value A or the First column name which we input. The macro should be in such a way i can able to input any column names to compare. Accordingly it need to compare the columns and put the result on the desired result column.

If the VBA can be designed as per the below way it will be really useful for me for future use..i.e. not only for 4 columns i may use if for multiple columns in future

1) Enter the number of columns to compare ( Suppose if i select 8 columns to compare)
2) Enter the First Column name to compare
3) Enter the Second Column name to compare
4) Enter the Third Column name to compare
5) Enter the Fourth Column name to compare
6) Enter the Fifth Column name to compare
7) Enter the Sixth Column name to compare
8) Enter the Seventh Column name to compare
9) Enter the Eighth Column name to compare
10) Enter the column name to put the result

[Excel Fox]

Here's a revised one

Private Sub CommandButton1_Click()

    Dim lngColumnIndex() As Long
    Dim lngLoop As Long
    Dim lngSelected As Long
    Dim lngRows As Long
    Dim lngTotalRows As Long
    Dim lngUniqueIndex As Long
    Dim strColumnHeaders As String
    Dim strSelected As String
    Dim blnHoldsTrue As Boolean
    Dim lngColumnsToCompare As Long
    Dim varUniques As Variant
    Const lngColumnHeaderRow As Long = 1
    
    lngColumnsToCompare = InputBox("Enter the number of columns to compare")
    If lngColumnsToCompare < 2 Then
        MsgBox "Minimum 2 columns required", vbOKOnly + vbInformation, "": Exit Sub
    End If
    On Error GoTo Err
    ReDim lngColumnIndex(1 To lngColumnsToCompare + 1)
    For lngLoop = 1 To ActiveSheet.UsedRange.Columns.Count
        strColumnHeaders = strColumnHeaders & lngLoop & " - " & Cells(lngColumnHeaderRow, lngLoop).Value & "|"
    Next lngLoop
    strColumnHeaders = "The column headers are " & vbLf & vbLf & Join(Split(strColumnHeaders, "|"), vbLf) & vbLf
    For lngLoop = 1 To lngColumnsToCompare
        For lngSelected = 1 To lngLoop - 1
            strSelected = strSelected & lngColumnIndex(lngSelected) & vbLf
        Next lngSelected
        lngColumnIndex(lngLoop) = InputBox(strColumnHeaders & strSelected & "Enter each column index one by one", "Column Compare")
        strSelected = "You have already selected:" & vbLf & vbLf
    Next lngLoop
    
    For lngSelected = 1 To lngLoop - 1
        strSelected = strSelected & lngColumnIndex(lngSelected) & vbLf
    Next lngSelected
    lngColumnIndex(lngLoop) = InputBox(strColumnHeaders & strSelected & "Enter column index where you want to show the comparison result", "Column Compare")
    lngTotalRows = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    ReDim varUniques(1 To lngTotalRows)
    blnHoldsTrue = True
    For lngRows = lngColumnHeaderRow + 1 To lngTotalRows
        For lngLoop = 2 To lngColumnsToCompare
            blnHoldsTrue = blnHoldsTrue And (IsNumeric(Application.Match(Cells(lngRows, lngColumnIndex(lngLoop - 1)).Value, Cells(lngColumnHeaderRow + 1, lngColumnIndex(lngLoop)).Resize(lngTotalRows - lngColumnHeaderRow), 0)))
        Next lngLoop
        If blnHoldsTrue Then
            lngUniqueIndex = lngUniqueIndex + 1
            varUniques(lngUniqueIndex) = Cells(lngRows, lngColumnIndex(1)).Value
        Else
            blnHoldsTrue = True
        End If
    Next lngRows
    ReDim Preserve varUniques(1 To lngUniqueIndex)
    Cells(lngColumnHeaderRow + 1, lngColumnIndex(lngLoop)).Resize(lngTotalRows - lngColumnHeaderRow).ClearContents
    Cells(lngColumnHeaderRow + 1, lngColumnIndex(lngLoop)).Resize(lngUniqueIndex).Value = Application.Transpose(varUniques)
    Exit Sub
Err:    MsgBox "Either cancelled by user, or incorrect entry made." & vbLf & vbLf & "If neither of these, unexpected error!", vbOKOnly + vbInformation, ""
    
End Sub