Link to home
Start Free TrialLog in
Avatar of Luis Diaz
Luis DiazFlag for Colombia

asked on

Excel VBA: match procedure with numeric and text values

Hello experts,
The following procedure allows me to identify values which are in based on two different ranges.
Sub Is_In()
    Dim wsSource As Worksheet
    Dim wsComaparison As Worksheet
    Dim rngSource As Range
    Dim ComparisonRange As Range
    Dim rCl As Range
    Dim LRSource As Long
    Dim LRComparison As Long
    Dim colSource As Long
    Dim colComparison As Long
    Dim cntMatch As Long
    
    Application.DisplayAlerts = False
    
    On Error Resume Next
    Set rngSource = Application.InputBox(Prompt:="Please Select any cell in your range source, in this range you will find the cells which are in your range to compare", Title:="Source Range Selection", Type:=8)
    
    Set ComparisonRange = Application.InputBox(Prompt:="Please Select any cell in the Range to compare", Title:="Select Range To Compare With", Type:=8)
    On Error GoTo 0
    
    If rngSource Is Nothing Then
        MsgBox "You didn't select any Source Range to compare.", vbExclamation
        Exit Sub
    ElseIf ComparisonRange Is Nothing Then
        MsgBox "You didn't select any Comparison Range to compare it with Source Range.", vbExclamation
        Exit Sub
    End If
    
    Set wsSource = rngSource.Parent
    Set wsComaparison = ComparisonRange.Parent
    
    colSource = rngSource.Column
    colComparison = ComparisonRange.Column
    
    LRSource = wsSource.Cells(Rows.Count, colSource).End(xlUp).Row
    LRComparison = wsComaparison.Cells(Rows.Count, colComparison).End(xlUp).Row
    
    Set rngSource = wsSource.Range(wsSource.Cells(2, colSource), wsSource.Cells(LRSource, colSource))
    Set ComparisonRange = wsComaparison.Range(wsComaparison.Cells(2, colComparison), wsComaparison.Cells(LRComparison, colComparison))
    
    If MsgBox("You are going to compare the range " & rngSource.Address(0, 0) & " on " & wsSource.Name & " Sheet with the range " & _
                ComparisonRange.Address(0, 0) & " on " & wsComaparison.Name & " Sheet." & vbNewLine & vbNewLine & _
              "Is that correct?", vbQuestion + vbYesNo, "Comfirm Please!") = vbNo Then

        MsgBox "You cancelled the range comparison.", vbExclamation, "Range Comparison Cancelled!"
        Exit Sub
    End If
    
    On Error GoTo Error_Routine
    
    For Each rCl In rngSource
        If IsNumeric(Application.Match(rCl, ComparisonRange, 0)) Then
            cntMatch = cntMatch + 1
            rCl.Interior.ColorIndex = "4"
        End If
    Next rCl
    
    MsgBox cntMatch & " values matched of total " & LRSource - 1 & " values.", vbExclamation
    
    Exit Sub
Error_Routine:
    MsgBox Err.Description, vbExclamation, "Something went wrong!"

    Application.DisplayAlerts = True

End Sub

Open in new window


The procedure works perfectly but I am having difficulties to make it work with the attached file.
The two ranges don't have the same format (number vs text) however when I put both in the same format I am not still getting the expected result.

Could you please advice which format should be used for both ranges. I expected to have number format for both but I tested and it doesn't work.
Thank you for your help.
Numeric-vs-text-values_20191013_201.xlsx
SOLUTION
Avatar of Subodh Tiwari (Neeraj)
Subodh Tiwari (Neeraj)
Flag of India image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Luis Diaz

ASKER

Thank you Subodh! It works as expected. I was wondering if the best is to change this in my add-in but I don't know if this is the best approach as the procedure works well for other ranges which have general format.

If Application.CountIf(ComparisonRange, rCl.Value) > 0 Then

Open in new window


Will allows me to cover all the cases no matter the format of both ranges?
Or the best is to keep the following:
If IsNumeric(Application.Match(rCl, ComparisonRange, 0)) Then

Open in new window


Thank you for your help.
You can replace the Application.Match with Application.Countif and it should work for all the scenarios.
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Indeed I tested and id works for the various cases!

I take the opportunity to ask:

1-How to replace the other procedure which I also have in my add-in and do the similar process:

Sub Is_In_Is_Not()

    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim RngToCompare As Range, RngToCompareWith As Range
    Dim colLetterSource As String, colLetterTarget As String
    Dim sRow As Long

    On Error Resume Next
    Set RngToCompare = Application.InputBox(Prompt:="Please activate the Source Sheet and select any cell in your source range (THEY SHOULD CONTAIN HEADERS)" & _
    vbNewLine & "In this range you will find the cells which are / or which are not in your range to compare", Type:=8)
    On Error GoTo 0
    If RngToCompare Is Nothing Then
        MsgBox "You didn't select any cell in the Source Range.", vbExclamation
        Exit Sub
    End If
    
    On Error GoTo Error_Routine

    Set wsSource = RngToCompare.Parent
    col = RngToCompare.Column
    If wsSource.Cells(1, col).Value <> "" Then
        sRow = 1
    Else
        sRow = wsSource.Cells(1, col).End(xlDown).Row
    End If
    lRw = wsSource.Cells(wsSource.Rows.Count, col).End(xlUp).Row
    Set RngToCompare = wsSource.Range(wsSource.Cells(sRow + 1, col), wsSource.Cells(lRw, col))

    On Error Resume Next
    Set RngToCompareWith = Application.InputBox(Prompt:="Please activate the target sheet and select any cell in the Range to compare with.", Type:=8)
    On Error GoTo 0
    If RngToCompareWith Is Nothing Then
        MsgBox "You didn't select any cell in the Range to compare with.", vbExclamation
        Exit Sub
    End If

    Set wsTarget = RngToCompareWith.Parent
    col = RngToCompareWith.Column
    If wsTarget.Cells(1, col).Value <> "" Then
        sRow = 1
    Else
        sRow = wsTarget.Cells(1, col).End(xlDown).Row
    End If

    lRw = wsTarget.Cells(wsTarget.Rows.Count, col).End(xlUp).Row
    Set RngToCompareWith = wsTarget.Range(wsTarget.Cells(sRow + 1, col), wsTarget.Cells(lRw, col))

    If MsgBox("You are going to compare the range " & RngToCompare.Address(0, 0) & " on " & wsSource.Name & " Sheet with the range " & RngToCompareWith.Address(0, 0) & " on " & wsTarget.Name & " Sheet." & vbNewLine & vbNewLine & _
              "Is that correct?", vbQuestion + vbYesNo, "Comfirm Please!") = vbNo Then

        MsgBox "You cancelled the range comparison.", vbExclamation, "Range Comparison Cancelled!"
        Exit Sub
    End If

    Application.ScreenUpdating = False

    For Each rCl In RngToCompare
        If Not IsError(Application.Match(rCl, RngToCompareWith, 0)) Then
            Intersect(RngToCompare.Cells(1).CurrentRegion, rCl.EntireRow).Interior.ColorIndex = 4
        Else
            Intersect(RngToCompare.Cells(1).CurrentRegion, rCl.EntireRow).Interior.ColorIndex = 3
        End If
    Next rCl
    
    Exit Sub
Error_Routine:
    MsgBox Err.Description, vbExclamation, "Something went wrong!"

    Application.ScreenUpdating = True
    
End Sub

Open in new window


2-And the second one which is the opposite of Is_In.
The following replacement is ok?

For Each rCl In rngSource
        If Application.CountIf(ComparisonRange, rCl.Value) = 0 Then
            cntNoMatch = cntNoMatch + 1
            rCl.Interior.ColorIndex = "3"
        End If
    Next rCl
    
    MsgBox cntNoMatch & " values were not matched of total " & LRSource - 1 & " values.", vbExclamation
    
    Exit Sub
Error_Routine:
    MsgBox Err.Description, vbExclamation, "Something went wrong!"

    Application.DisplayAlerts = True

End Sub

Open in new window


Thank you for your help.
ASKER CERTIFIED SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Thank you very much Subodh.
I added to my add-in and I tested and they work!
Great! You're welcome Luis!