Exact comparison of string column between 2 worksheets excel vba

Question

FOR SOME REASON IM NOT ABLE TO COMMENT. The answers below all gave me a variety of errors from activex cannot create object to object undefined.

This is my code.

Sub Main()
Application.ScreenUpdating = False

Dim stNow As String
stNow = Now


Set sh1 = ThisWorkbook.Worksheets("StrategyIn")
Set sh2 = ThisWorkbook.Worksheets("Contractor")

Dim arr As Variant
arr = sh1.Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row).Value



Dim varr As Variant
varr = sh2.Range("E2:E" & Range("E" & Rows.Count).End(xlUp).Row).Value


Dim temp As Integer
temp = 0


Dim x As Variant, y As Variant, Match As Boolean
For Each x In arr
    Match = False
    For Each y In varr
        If x = y Then Match = True
    Next y
    If Not Match Then
    temp = temp + 1
    End If
Next

MsgBox "Number of names that do not match = " & temp
    'Debug.Print DateDiff("s", stNow, Now)
Application.ScreenUpdating = True
End Sub

It works when I remove the reference to other worksheets to get the range, works perfectly when I am in one sheet and data is all gathered in one sheet. There is a logical error which results in me getting a number of names that do no match as = 1. Thanks for your help!

Answer 1

Sub to Match

Sub Match()  

Dim WksS as Range, WksC as Range
Dim stNow as String
Dim rSI as Range, rCon as Range
Dim iLR as Integer, iTemp as Variant, vVal as Variant

Set WksS = Worksheets("StrategyIn")
Set WksC = Worksheets("Contractor")
Set rSI = WksS.Range("A2", WksS.Range("A2").End(xlDown))
Set rCon = WksC.Range("E2", WksC.Range("E2").End(xlDown))
stNow = Now()

iLR = WksC.Range("A2").End(xlDown).Row '' "lastrow"
iTemp = 0

'' Because is only one column you dont need to create an array
For Each vVal in rCon 
    iTemp = iTemp + IIF(Fun_Val(vVal,rCon),1,0)
Next vVal

iTemp = (iTemp/iLR)*100

MsgBox "Percentage difference = " & temp & "%"

Exit Sub

Function to Validate

Function Fun_Val(dVal As Double, rRange As Range) As Boolean  

On Error GoTo errHdlr  

    Fun_Val = IsNumeric(Application.WorksheetFunction.Match(dVal, rRange, 0))  

    Exit Function  
    errHdlr:  
    Fun_Val = False  

End Function

BTW you should consider change the way you set variables.

1. Ranges
   arr = Range("B2:B" & Range("B"&Rows.Count).End(xlUp).Row).Value to
   arr = Range("B2", Range("B2").End(xlDown))
2. Declaration
   Dim x, y, Match As Boolean to
   Dim x as Variant, y as Variant, Match As Boolean
3. Worksheets
   Worksheets("StrategyIn")
   to
   Dim Wks as Worksheet
Set Wks = Worksheets("StrategyIn")
   this way you could avoid errors between Worksheets

Answer 2

You can specify the worksheet that the range is referencing within the Range variable.

Sub Match()

'Call Concatenate

Application.ScreenUpdating = False

Dim stNow As String
stNow = Now

Dim arr As Range
Set arr = Worksheets("StrategyIn").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Value


Dim varr As Range
Set varr = Worksheets("Contractor").Range("E2:E" & Range("E" & Rows.Count).End(xlUp).Row).Value


Dim temp As Double
temp = 0

With Worksheets("StrategyIn")
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

Worksheets("Contractor").Select
Dim x, y, Match As Boolean

For Each x In arr

    Match = False
        For Each y In varr
            If x = y Then Match = True
Next y

    If Not Match Then
        temp = temp + 1
    End If

Next
   'temp = (temp / lastrow) * 100

MsgBox "Percentage difference = " & temp & "%"

Application.ScreenUpdating = True
End Sub

Answer 3

Not sure why you used Range A in code for StrategIn . You can make use of .NET's Collection ArrayList for fast check in item found in array.

Below code will be suitable for your use, it's okay if you have very large data set in both columns. I changed the final display of the differences in Immediate Window instead of MsgBox for table like output.

Option Explicit

Sub ShowDifferences()
    Dim aColB As Variant, aColE As Variant ' Memory allocations for the range values
    Dim oItem As Variant
    Dim oListB As Object, oListE As Object, oTemp As Object ' Arraylist Objects from .NET

    ' Create Collections from .NET
    Set oListB = CreateObject("System.Collections.ArrayList")
    Set oListE = CreateObject("System.Collections.ArrayList")
    Set oTemp = CreateObject("System.Collections.ArrayList")

    ' Load the ranges into memory array
    With ThisWorkbook.Worksheets("StrategyIn")
        aColB = .Range("B2:B" & .Range("B" & Rows.Count).End(xlUp).Row).Value
    End With
    With ThisWorkbook.Worksheets("Contractor")
        aColE = .Range("E2:E" & .Range("E" & Rows.Count).End(xlUp).Row).Value
    End With

    ' Add these data to the ArrayList
    For Each oItem In aColB
        If Not oListB.Contains(oItem) Then oListB.Add oItem
    Next
    For Each oItem In aColE
        If Not oListE.Contains(oItem) Then oListE.Add oItem
    Next

    ' Free memory of Range values
    Set aColB = Nothing
    Set aColE = Nothing

    ' Compare the differences (different if each B not found in E)
    For Each oItem In oListB
        If Not oListE.Contains(oItem) Then oTemp.Add oItem
    Next

    ' Display the result
    Debug.Print "B-items", "E-items", "Differences (#Diff/#B)"
    Debug.Print oListB.Count, oListE.Count, oTemp.Count & Format(oTemp.Count / oListB.Count, " (0%) ") & Join(oTemp.ToArray, "|")

    ' CleanUp
    oListB.Clear
    oListE.Clear
    oTemp.Clear
    Set oListB = Nothing
    Set oListE = Nothing
    Set oTemp = Nothing
End Sub

Answer 4

I have tried a different solution, it worked on my data. But I am not sure if that is exactly what you want.

Sub mismatch()

Dim Lastrow_StrategyIn As Integer, temp As Integer
Dim strg As Worksheet, contr As Worksheet

Set strg = Worksheets("StrategyIn")
Set contr = Worksheets("Contractor")

Lastrow_StrategyIn = strg.Range("A65555").End(3).Row


For i = 2 To Lastrow_StrategyIn
    strg.Cells(i, 2) = Application.IfError(Application.VLookup(strg.Cells(i, 1), contr.Range("A:A"), 1, 0), "")
    If strg.Cells(i, 2) = "" Then
        temp = temp + 1
    End If

Next
MsgBox (temp / (Lastrow_StrategyIn - 1)) * 100 & "%"

End Sub

Answer 5

Hope this will work for you.

Sub Main()
    Dim match As Boolean
    Dim temp As Long
    Dim blankcount As Long
    Dim lastrowS As Long
    Dim lastrowC As Long
    match = False
    lastrowS = Worksheets("StrategyIn").Range("B" & Rows.Count).End(xlUp).Row
    lastrowC = Worksheets("Contractor").Range("E" & Rows.Count).End(xlUp).Row
    With Worksheets("StrategyIn")
        For i = 2 To lastrowS
            If .Range("B" & i).Value <> "" Then
                For j = 2 To lastrowC
                    If .Range("B" & i).Value = Worksheets("Contractor").Range("E" & j).Value Then
                        match = True
                    End If
                Next j
            Else
                blankcount = blankcount + 1
            End If
            If match = False Then
                temp = temp + 1
            Else
                match = False
            End If
        Next i
    End With
    MsgBox "Number of names that do not match = " & (temp - blankcount)
End Sub

Proof of Work