Introduction | Example | Tutorial | Applications

Introduction - Compare

I have another great VBA function for you all! This VBA UDF (User Defined Function) will compare two cells in Excel and return whether or not the cells are identical. If they are not identical, the function can optionally show the delta between the values as long as both values are numeric.

Because of its flexibility, this function is perfect for comparing data from two different sources. It also makes a great companion to my Compare Two Columns for Differences macro!


Example - Compare

VBA Function

Copy and paste the code* below if you’re in a hurry. If you want to learn how it works and how to use it, scroll down to the Tutorial section!

Function compare(ByVal Cell1 As Range, ByVal Cell2 As Range, Optional CaseSensitive As Variant, Optional delta As Variant, Optional MatchString As Variant)
'******************************************************************************
'***DEVELOPER:   Ryan Wells (wellsr.com)                                      *
'***DATE:        04/2016                                                      *
'***DESCRIPTION: Compares Cell1 to Cell2 and if identical, returns "-" by     *
'***             default but a different optional match string can be given.  *
'***             If cells are different, the output will either be "FALSE"    *
'***             or will optionally show the delta between the values if      *
'***             numeric.                                                     *
'***INPUT:       Cell1 - First cell to compare.                               *
'***             Cell2 - Cell to compare against Cell1.                       *
'***             CaseSensitive - Optional boolean that if set to TRUE, will   *
'***                             perform a case-sensitive comparison of the   *
'***                             two entered cells. Default is TRUE.          *
'***             delta - Optional boolean that if set to TRUE, will display   *
'***                     the delta between Cell1 and Cell2.                   *
'***             MatchString - Optional string the user can choose to display *
'***                           when Cell1 and Cell2 match. Default is "-"     *
'***OUTPUT:      The output will be "-", a custom string or a delta if the    *
'***             cells match and will be "FALSE" if the cells do not match.   *
'***EXAMPLES:     =compare(A1,B1,FALSE,TRUE,"match")                          *
'***              =compare(A1,B1)                                             *
'******************************************************************************
 
'------------------------------------------------------------------------------
'I. Declare variables
'------------------------------------------------------------------------------
Dim strMatch As String 'string to display if Cell1 and Cell2 match
 
'------------------------------------------------------------------------------
'II. Error checking
'------------------------------------------------------------------------------
'Error 0 - catch all error
On Error GoTo CompareError:
 
'Error 1 - MatchString is invalid
If IsMissing(MatchString) = False Then
    If IsError(CStr(MatchString)) Then
        compare = "Invalid Match String"
        Exit Function
    End If
End If
 
'Error 2 - Cell1 contains more than 1 cell
If IsArray(Cell1) = True Then
    If Cell1.Count <> 1 Then
        compare = "Too many cells in variable Cell1."
        Exit Function
    End If
End If
 
'Error 3 - Cell2 contains more than 1 cell
If IsArray(Cell2) = True Then
    If Cell2.Count <> 1 Then
        compare = "Too many cells in variable Cell2."
        Exit Function
    End If
End If
 
'Error 4 - delta is not a boolean
If IsMissing(delta) = False Then
    If delta <> CBool(True) And delta <> CBool(False) Then
        compare = "Delta flag must be a boolean (TRUE or FALSE)."
        Exit Function
    End If
End If
 
'Error 5 - CaseSensitive is not a boolean
If IsMissing(CaseSensitive) = False Then
    If CaseSensitive <> CBool(True) And CaseSensitive <> CBool(False) Then
        compare = "CaseSensitive flag must be a boolean (TRUE or FALSE)."
        Exit Function
    End If
End If

'------------------------------------------------------------------------------
'III. Initialize Variables
'------------------------------------------------------------------------------
If IsMissing(CaseSensitive) Then
    CaseSensitive = CBool(True)
ElseIf CaseSensitive = False Then
    CaseSensitive = CBool(False)
Else
    CaseSensitive = CBool(True)
End If

If IsMissing(MatchString) Then
    strMatch = "-"
Else
    strMatch = CStr(MatchString)
End If
 
If IsMissing(delta) Then
    delta = CBool(False)
ElseIf delta = False Then
    delta = CBool(False)
Else
    delta = CBool(True)
End If
 
'------------------------------------------------------------------------------
'IV. Check for matches
'------------------------------------------------------------------------------
If Cell1 = Cell2 Then
    compare = strMatch
ElseIf CaseSensitive = False Then
    If UCase(Cell1) = UCase(Cell2) Then
        compare = strMatch
    ElseIf delta = True And IsNumeric(Cell1) And IsNumeric(Cell2) Then
        compare = Cell1 - Cell2
    Else
        compare = CBool(False)
    End If
ElseIf Cell1 <> Cell2 And delta = True Then
    If IsNumeric(Cell1) And IsNumeric(Cell2) Then
        'No case sensitive check because if not numeric, doesn't matter.
        compare = Cell1 - Cell2
    Else
        compare = CBool(False)
    End If
Else
    compare = CBool(False)
End If
Exit Function
 
'------------------------------------------------------------------------------
'V. Final Error Handling
'------------------------------------------------------------------------------
CompareError:
    compare = "Error Encountered: " & Err.Number & ", " & Err.Description
End Function

Make powerful macros with our free VBA Developer Kit

Tutorials like this can be complicated. That’s why we created our free VBA Developer Kit and our Big Book of Excel VBA Macros to supplement this tutorial. Grab them below and you’ll be writing powerful macros in no time.

I'll take a free VBA Developer Kit


Tutorial - Compare

Arguments

The flexible compare function, =compare()*, accepts 5 arguments, but only 2 of them are required:

=compare(Cell1, Cell2, [CaseSensitive], [delta], [MatchString])

Here’s a description of what you need to know about each of these arguments:

Argument            Type       Description
Cell1 Cell First cell to compare.
Cell2 Cell Cell to compare against Cell1.
CaseSensitive   Boolean Optional boolean that if set to TRUE, will perform a case-sensitive comparison of the two entered cells. Default is TRUE.
delta Boolean   Optional boolean that if set to TRUE, will display the delta between Cell1 and Cell2. Default is FALSE.
MatchString String Optional string the user can choose to display when Cell1 and Cell2 match. Default is “-“


If there’s one thing I want you to remember, it’s that you really only need 2 arguments - Cell1 and Cell2. If you mess up the other arguments, don’t worry. The UDF is smart enough to tell you when you’ve made an error and how to fix the errors!

See It In Action

Because of all the optional arguments, this compare function can do many incredible things. We’ll go through a couple examples in a little bit, but first, let’s create a hypothetical scenario.

  1. Let’s assume you have some data in a spreadsheet. The data could be anything from names on a wedding list to fuel assemblies in a nuclear reactor.
  2. Now, you come across a second set of data from a different source. A friend or coworker may have made his or her own list or you may have stumbled across data from an online PDF.
  3. You want to make sure your spreadsheet matches the data you found in the other source so you copy and paste them right beside each other.

Right now, your spreadsheet probably looks something like this:

Excel Compare Function Data

Instead of typing a complicated IF statement in Excel to see if the values are identical, you can use this compare macro!

Okay, okay. before we move on to the demonstrations, go ahead and paste the example macro in an Excel VBA module.

Example 1 - Basic Comparison

We’ll start by performing a basic comparison. Type a function similar to the following one into Excel:

=compare(B2,G2)

By default, the =compare() function will look to see if cell B2 matches cell G2. In my example above, the cells do match so the macro UDF returns a value of “-“. You can drag this function down and over, just like any other Excel function to compare large ranges at once. Here’s how it will look:

Excel Compare UDF Case Sensitive

Notice how the values in cells B4 and G4 are identical, except one has a lower case “c” and one has an upper case “C.” What if we don’t care about letter casing? Let’s take a look in Example 2!

Example 2 - Case-Insensitive Comparison

The compare function is capable of ignoring letter case and checking for a match regardless of upper and lower case letters.

To do that, we’ll just add FALSE to the third argument in the function - the CaseSensitive argument. Let’s take a look:

=compare(B2,G2,FALSE)

How does this change our results?

Excel Compare UDF Case Insensitive

Now, the comparison of cells B4 and G4 returns a match!

Example 3 - Deltas and Match Strings

For the final example, let’s go all in.

Do you see how cells D7 and I7 are numeric? What if instead of just showing which cells don’t match, we want to find out what the difference between the numeric cells is.

You can do that with the optional 4th argument - the delta argument. Just set it to TRUE to perform the math for you.

While we’re at it, let’s pretend you still don’t care about case-sensitivity but you don’t like showing “-“ when the cells match. Instead, you want to read the words “match.” We’ll combine all these tricks in this demonstration:

=compare(B2,G2,FALSE,TRUE,"match")

Here’s how the results look:

Excel Compare UDF Case Demo

The value in cell C16 still reports FALSE because the cells being compared are not numeric and can’t be subtracted from one another. However, the value in cell D18 shows “-1” because the difference between cells D7 and I7 is -1!


Application Ideas

Having a great comparison tool at your disposal is great for verifying your work is correct. You can compare and check results to prevent yourself from accidentally publishing an embarrassing typo or miscalculation.

I’ve already suggested many great ways to use this UDF macro. I regularly use it to compare results from two different code executions or to verify fuel assembly names developed under two separate processes are identical.

You can use the =compare() function to compare names, phone numbers, addresses, mathematical expressions and countless other items. If you need to compare it, the compare UDF can do it.


That’s all for this tutorial. When you’re ready to take your VBA to the next level, subscribe using the form below.

*Ryan Wells and wellsr.com are not responsible for erroneous calculations or other undesirable results encountered while using the compare function.