Compare Data
Carefully adjust the values in the constants (Const) section to fit your needs.
Sub CompareData()
Const cSrc As Variant = "Sheet1" ' Source Worksheet Name/Index
Const cSrcChecks As String = "B:F" ' Source Check Columns Address
Const cSrcCrit As Variant = "A" ' Source Criteria Column Letter/Number
Const cSrcFR As Long = 1 ' Source First Row Number
Const cTgt As Variant = "Sheet2" ' Target Worksheet Name/Index
Const cTgtChecks As String = "B:F" ' Target Check Columns Address
Const cTgtCrit As Variant = "A" ' Target Criteria Column Letter/Number
Const cRes As Variant = "H" ' Result Column Letter/Number
Const cTgtFR As Long = 1 ' Target First Row Number
Const cYes As Variant = "True" ' Yes String
Const cNo As Variant = "False" ' No String
Const cNot As Variant = "Not Found" ' Not Found String
Const cEmpty As Variant = "Empty" ' Empty String
Dim vntSrcC As Variant ' Source Criteria Array
Dim vntTgtC As Variant ' Target Criteria Array
Dim vntS As Variant ' Source Array
Dim vntT As Variant ' Target Array
Dim vntR As Variant ' Result Array
Dim varTgt As Variant ' Current Value (in Target Criteria Array)
Dim NorSrc As Long ' Source Number of Rows
Dim NorTgt As Long ' Target Number of Rows
Dim Noc As Long ' Source/Target Number of Columns
Dim Lur As Long ' Source/Target Last Row Number
Dim i As Long ' Target/Criteria/Result Array Row Counter
Dim j As Long ' Source/Target Array Columns Counter
Dim k As Long ' Source/Criteria Array Row Counter
' In Source Worksheet (Check Columns)
With ThisWorkbook.Worksheets(cSrc).Columns(cSrcChecks)
' Calculate (count) Source/Target Number of Columns.
Noc = .Columns.Count
' Calculate Source Last Used Row Number.
Lur = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Row
' Calculate Source Number of Rows.
NorSrc = Lur - cSrcFR + 1
' Calculate Source Criteria Range.
' Copy Source Criteria Range to Source Criteria Array.
vntSrcC = .Worksheet.Columns(cSrcCrit) _
.Resize(NorSrc).Offset(cSrcFR - 1)
' Calculate Source Range.
' Copy Source Range to Source Array.
vntS = .Resize(NorSrc, Noc).Offset(cSrcFR - 1)
End With
' In Target Worksheet (Check Columns)
With ThisWorkbook.Worksheets(cTgt).Columns(cTgtChecks)
' Check if Target Number of Columns is euqal to Source Number of
' Columns.
If .Columns.Count <> Noc Then
MsgBox "The number of Check Columns NOT equal. Adjust Source " _
& "Check Columns (cSrcChecks) and Target Check Columns " _
& "(cTgtChecks) to have an equal number of columns.", _
vbCritical, "Check Columns Error"
Exit Sub
End If
' Calculate Target Last Used Row Number.
Lur = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Row
' Calculate Target Number of Rows.
NorTgt = Lur - cTgtFR + 1
' Calculate Target Criteria Range.
' Copy Target Criteria Range to Target Criteria Array.
vntTgtC = .Worksheet.Columns(cTgtCrit) _
.Resize(NorTgt).Offset(cTgtFR - 1)
' Calculate Target Range.
' Copy Target Range to Target Array.
vntT = .Resize(NorTgt, Noc).Offset(cTgtFR - 1)
End With
' Resize Result Array to rows of Target Array and one column.
ReDim vntR(1 To NorTgt, 1 To 1)
' Loop through rows of Target Criteria Array.
For i = 1 To NorTgt
' Write current value in Target Criteria Array to Current Value.
varTgt = vntTgtC(i, 1)
' Check if Current Value is not empty.
If varTgt <> "" Then ' NOT empty (<>"").
' Check if Match function produces an error.
If Not IsError(Application.Match(varTgt, vntSrcC, 0)) Then ' FOUND.
' Write position of found match to Source/Criteria Array
' Row Counter.
k = Application.Match(varTgt, vntSrcC, 0)
' Loop through columns of Source/Target Array.
For j = 1 To Noc
' Check if values in Source and Target Array are NOT equal.
If vntS(k, j) <> vntT(i, j) Then Exit For
Next
' VBA Help: ...For counter = start To end...
' Use the 'For Next Trick' to determine if all values were
' equal i.e. if counter is by one greater than end, the loop
' was NOT interrupted i.e. no value is NOT equal, i.e. all
' values are equal.
If j = Noc + 1 Then ' EQUAL.
vntR(i, 1) = cYes
Else ' NOT equal.
vntR(i, 1) = cNo
End If
Else ' NOT found.
vntR(i, 1) = cNot
End If
Else ' EMPTY (="").
vntR(i, 1) = cEmpty
End If
Next
' In Target Worksheet
With ThisWorkbook.Worksheets(cTgt).Columns(cRes)
' Calculate Result Range.
' Copy Result Array to Result Range.
.Resize(NorTgt).Offset(cTgtFR - 1) = vntR
End With
End Sub
COUNTIFS, and check if it is>0. (You may also want to take the tour, and review the How to Ask page) - Chronocidal