Compare two worksheet ranges using VBA in Microsoft Excel

Follow by Email
Facebook
Facebook
Google+
http://www.exceltip.com/cells-ranges-rows-and-columns-in-vba/compare-two-worksheet-ranges-using-vba-in-microsoft-excel.html">
SHARE




In case you want to compare two worksheet ranges then you should read this article. We will use VBA code to demonstrate how to compare two ranges of cells.

 
Question: I’ve got two columns where one column contains list of top 6 teams for year 2008 & the other column contains top 6 teams for year 2009 by their ranking. There are some teams which have captured the same spot or you can say rank. Now, I need some ways of comparing the second list with the first one and conclude the teams which have changed their rankings.

 

We will focus on three scenarios:

  • Compare two ranges in the active worksheet in the active workbook
  • Compare two ranges in two different worksheets in the active workbook
  • Compare two ranges in two different worksheets in two different workbooks

Compare two ranges in the active worksheet

Following is the snapshot of data:

 

img1

 

To compare the list of two columns, we need to follow the below steps to launch VB editor

  • Click on Developer tab
  • From Code group, select Visual Basic

 

img2

 

  • Copy the below code in the standard module

 

Sub TestCompareWorksheetRanges()
    ' compare two ranges in the active worksheet in the active workbook' --- Comment
    CompareWorksheetRanges Range("A1:A100"), Range("B1:B100")
    
    ' compare two ranges in two different worksheets in the active workbook' --- Comment
    CompareWorksheetRanges Worksheets(1).Range("A1:A100"), _
        Worksheets(2).Range("B1:B100")
    
    ' compare two ranges in two different worksheets in two different workbooks' --- Comment
    CompareWorksheetRanges ActiveWorkbook.Worksheets(1).Range("A1:A100"), _
        Workbooks("WorkBookName.xls").Worksheets(1).Range("B1:B100")
End Sub

Sub CompareWorksheetRanges(rng1 As Range, rng2 As Range)
Dim r As Long, c As Integer
Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String
Dim rptWB As Workbook, DiffCount As Long
    If rng1 Is Nothing Or rng2 Is Nothing Then Exit Sub
    If rng1.Areas.Count > 1 Or rng2.Areas.Count > 1 Then
        MsgBox "Can't compare multiple selections!", _
            vbExclamation, "Compare Worksheet Ranges"
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Application.StatusBar = "Creating the report..."
    Set rptWB = Workbooks.Add
    Application.DisplayAlerts = False
    While Worksheets.Count > 1
        Worksheets(2).Delete
    Wend
    Application.DisplayAlerts = True
    With rng1
        lr1 = .Rows.Count
        lc1 = .Columns.Count
    End With
    With rng2
        lr2 = .Rows.Count
        lc2 = .Columns.Count
    End With
    maxR = lr1
    maxC = lc1
    If maxR < lr2 Then maxR = lr2
    If maxC < lc2 Then maxC = lc2
    If lr1 <> lr2 Or lc1 <> lc2 Then
        If MsgBox("The two ranges you want to compare are of different size!" & _
            Chr(13) & "Do you want to continue anyway?", _
            vbQuestion + vbYesNo, "Compare Worksheet Ranges") = vbNo Then Exit Sub
    End If
    DiffCount = 0
    For c = 1 To maxC
        Application.StatusBar = "Comparing cells " & _
            Format(c / maxC, "0 %") & "..."
        For r = 1 To maxR
            cf1 = ""
            cf2 = ""
            On Error Resume Next
            cf1 = rng1.Cells(r, c).FormulaLocal
            cf2 = rng2.Cells(r, c).FormulaLocal
            On Error GoTo 0
            If cf1 <> cf2 Then
                DiffCount = DiffCount + 1
                Cells(r, c).Formula = "'" & cf1 & " <> " & cf2
            End If
        Next r
    Next c
    Application.StatusBar = "Formatting the report..."
    With Range(Cells(1, 1), Cells(maxR, maxC))
        .Interior.ColorIndex = 19
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        On Error Resume Next
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        On Error GoTo 0
    End With
    Columns("A:IV").ColumnWidth = 20
    rptWB.Saved = True
    If DiffCount = 0 Then
        rptWB.Close False
    End If
    Set rptWB = Nothing
    Application.StatusBar = False
    Application.ScreenUpdating = True
    MsgBox DiffCount & " cells contain different formulas!", _
        vbInformation, "Compare Worksheet Ranges"
End Sub

 

img3

 

img4

 

img5

 

Please note: there is a macro name “TestCompareWorksheetRanges” which needs a close attention before running the macro.

 

img6

 

  • CompareWorksheetRanges Range(“A1:A100″), Range(“B1:B100″); this line of code will run on active worksheet.
  • We need to comment out the other two lines

 

img7

 

  • The above macro is all set to run and as we click on run button, a new sheet will be inserted with the following result:

 

img8

 

Compare two ranges in two different worksheets in the active workbook

Following is the snapshot of data we have in 2 sheets:

 

img9

 

img10

 

This time, we need to comment out the first & last code lines in order to run the second code. Refer to below image:

 

img11

 

Compare two ranges in two different worksheets in two different workbooks

To run macro in different workbooks, we will comment out on the above two lines of code & uncomment the last line; refer below image:

 

img12

 

Conclusion: With the above code, we can compare the data from two columns, two sheets or two different workbooks.

 

If you liked our blogs, share it with your friends on Facebook. And also you can follow us on Twitter and Facebook.

We would love to hear from you, do let us know how we can improve, complement or innovate our work and make it better for you. Write us at [email protected]

 
 

Please follow and like us:
44


One thought on “Compare two worksheet ranges using VBA in Microsoft Excel

Leave a Reply

Your email address will not be published. Required fields are marked *


3 + = ten

You may use these HTML tags and attributes: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong>