Excel VBA: compare sheets

Hello experts,

I have two sheets  

I would like to add to my personal.xlsb a procedure which cover the following requirements:

1.      Inputbox “Select initial range to compare related to first sheet to compare”
2.      Inputbox “Select initial range to compare related to second sheet to compare”
3.      Create a Comparison sheet as attached in which true/false values should be displayed based on = formula.
4.      Highlight false values.

I attached dummy file.

Key information:
-True, False values should go till the last used Range, related to Sheet1 & Sheet2. The best is to identify this by checking last used range of Sheet1 and Sheet2. If one of the sheet have more used range this should be the reference
-If comparison sheet already exists, delete it.

If you have questions please contact me
comparison_14122018.xlsx
LVL 1
LD16Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Fabrice LambertConsultingCommented:
This should be an add-in instead, since it will only apply to a few workbooks.

Altering personnal.xlsb impact all workbooks, regardless of their content.
LD16Author Commented:
Thank you Fabrice for your comment.
Since the comparison will be launch for sheets in the same workbook, we can proceed in a first place by launching through personal.xlsb.
Thank you again for your help.
Ejgil HedegaardCommented:
Try this
Option Explicit

Sub CompareSheets()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet, wsCompare As Worksheet, ws As Worksheet
    Dim rg1 As Range, rg2 As Range
    Dim rw1 As Long, rw2 As Long
    Dim col1 As Integer, col2 As Integer
    Set rg1 = Application.InputBox("Select initial range to compare related to first sheet to compare", "First sheet", Type:=8)
    Set rg2 = Application.InputBox("Select initial range to compare related to second sheet to compare", "Second sheet", Type:=8)
    Set ws1 = rg1.Parent
    Set ws2 = rg2.Parent
    Set wb1 = ws1.Parent
    Set wb2 = ws2.Parent
    If wb1.Name <> wb2.Name Then
        MsgBox "Not same workbook, no compare"
        End
    Else
        If ws1.Name = ws2.Name Then
            MsgBox "Same sheet selected, no compare"
            End
        Else
            rw1 = ws1.Cells.SpecialCells(xlCellTypeLastCell).Row
            rw2 = ws2.Cells.SpecialCells(xlCellTypeLastCell).Row
            col1 = ws1.Cells.SpecialCells(xlCellTypeLastCell).Column
            col2 = ws2.Cells.SpecialCells(xlCellTypeLastCell).Column
            rw2 = WorksheetFunction.Max(rw1, rw2)
            col2 = WorksheetFunction.Max(col1, col2)
            For Each ws In wb1.Worksheets
                If ws.Name = "Comparison" Then
                    ws.Cells.Clear
                    Set wsCompare = ws
                End If
            Next ws
            If wsCompare Is Nothing Then
                wsCompare = wb1.Worksheets.Add
                wsCompare.Name = "Comparison"
            End If
            wsCompare.Range(Cells(1, 1), Cells(rw2, col2)).Formula = "='" & ws1.Name & "'!RC='" & ws2.Name & "'!RC"
            For rw1 = 1 To rw2
                For col1 = 1 To col2
                    If wsCompare.Cells(rw1, col1) = False Then
                        wsCompare.Cells(rw1, col1).Interior.Color = vbRed
                    End If
                Next col1
            Next rw1
        End If
    End If
End Sub

Open in new window

Maximize Customer Retention with Superior Service

The IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more to help build customer satisfaction and retention.

LD16Author Commented:
Thank you very much for this proposal. I will take the the time to test it today.
LD16Author Commented:
I just performed a test and I have the following error message:
Capture.PNGRelated to the following line:
2018-12-15-01_15_45-Microsoft-Visual.pngThank you in advance for your help.
Fabrice LambertConsultingCommented:
Since the comparison will be launch for sheets in the same workbook, we can proceed in a first place by launching through personal.xlsb.
Answer to the following questions:
Will the script Apply to any workbook ?

As for the error, since wsCompare is an object, you need the Set instruction to initialise it.
Set wsCompare = wb1.Worksheets.Add

Open in new window

Side note:
Cells highlighting is better done as conditional formating (let's not re-invent the wheel).

@Ejgil Hedegaard:
Even if it work, your function break the SRP, and should be split into 3 function:
- 1st one doing the comparision.
- 2nd one doing the highlight.
- 3rd one Calling the 2 above.
Ejgil HedegaardCommented:
Forgot the set instruction on that line, just add it.

@Fabrice
What do you mean by "break the SRP"
Fabrice LambertConsultingCommented:
@Ejgil Hedegaard:
Single Responsibility Principle.

A class or function should have one, and only one responsibility, so it is easyer to understand and maintain.
LD16Author Commented:
Thank you very much for your feedbacks.
@Ejgil I tested last version with the following code and it works when Comparison sheet doesn't exist however when it exist I got the the following error message:
comparison_error.pngI tested with the following procedure
Sub CompareSheets()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet, wsCompare As Worksheet, ws As Worksheet
    Dim rg1 As Range, rg2 As Range
    Dim rw1 As Long, rw2 As Long
    Dim col1 As Integer, col2 As Integer
    Set rg1 = Application.InputBox("Select initial range to compare related to first sheet to compare", "First sheet", Type:=8)
    Set rg2 = Application.InputBox("Select initial range to compare related to second sheet to compare", "Second sheet", Type:=8)
    Set ws1 = rg1.Parent
    Set ws2 = rg2.Parent
    Set wb1 = ws1.Parent
    Set wb2 = ws2.Parent
    If wb1.Name <> wb2.Name Then
        MsgBox "Not same workbook, no compare"
        End
    Else
        If ws1.Name = ws2.Name Then
            MsgBox "Same sheet selected, no compare"
            End
        Else
            rw1 = ws1.Cells.SpecialCells(xlCellTypeLastCell).Row
            rw2 = ws2.Cells.SpecialCells(xlCellTypeLastCell).Row
            col1 = ws1.Cells.SpecialCells(xlCellTypeLastCell).Column
            col2 = ws2.Cells.SpecialCells(xlCellTypeLastCell).Column
            rw2 = WorksheetFunction.Max(rw1, rw2)
            col2 = WorksheetFunction.Max(col1, col2)
            For Each ws In wb1.Worksheets
                If ws.Name = "Comparison" Then
                    ws.Cells.Clear
                    Set wsCompare = ws
                End If
            Next ws
            If wsCompare Is Nothing Then
                Set wsCompare = wb1.Worksheets.Add
                wsCompare.Name = "Comparison"
            End If
            wsCompare.Range(Cells(1, 1), Cells(rw2, col2)).Formula = "='" & ws1.Name & "'!RC='" & ws2.Name & "'!RC"
            For rw1 = 1 To rw2
                For col1 = 1 To col2
                    If wsCompare.Cells(rw1, col1) = False Then
                        wsCompare.Cells(rw1, col1).Interior.Color = vbRed
                    End If
                Next col1
            Next rw1

Open in new window


In order to prevent to have error message. Is it possible to add a exit sub with the following message:
"Unable to run the procedure"
"-Check that your initial range to compare is composed by SheetName + Range ex: "Sheet1$A1$1"
"-Check that your initial range to compare is different from both sheets involved by the comparison"
Ejgil HedegaardCommented:
It works here, but sometimes different Excel versions works slightly different.
The formula is R1C1 notation, so could be it is needed to specify directly on your version, changed to that.

If you select the sheet by selecting a cell (or cells) on the sheet, the notation should be correct.
No need to type it.

Option Explicit

Sub CompareSheets()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet, wsCompare As Worksheet, ws As Worksheet
    Dim rg1 As Range, rg2 As Range
    Dim rw1 As Long, rw2 As Long
    Dim col1 As Integer, col2 As Integer
    
    On Error GoTo ErrorExit
    
    Set rg1 = Application.InputBox("Select initial range to compare related to first sheet to compare", "First sheet", Type:=8)
    Set rg2 = Application.InputBox("Select initial range to compare related to second sheet to compare", "Second sheet", Type:=8)
    Set ws1 = rg1.Parent
    Set ws2 = rg2.Parent
    Set wb1 = ws1.Parent
    Set wb2 = ws2.Parent
    If wb1.Name <> wb2.Name Then
        MsgBox "Not same workbook, no compare"
        End
    Else
        If ws1.Name = ws2.Name Then
            MsgBox "Same sheet selected, no compare"
            End
        Else
            rw1 = ws1.Cells.SpecialCells(xlCellTypeLastCell).Row
            rw2 = ws2.Cells.SpecialCells(xlCellTypeLastCell).Row
            col1 = ws1.Cells.SpecialCells(xlCellTypeLastCell).Column
            col2 = ws2.Cells.SpecialCells(xlCellTypeLastCell).Column
            rw2 = WorksheetFunction.Max(rw1, rw2)
            col2 = WorksheetFunction.Max(col1, col2)
            For Each ws In wb1.Worksheets
                If ws.Name = "Comparison" Then
                    ws.Cells.Clear
                    Set wsCompare = ws
                End If
            Next ws
            If wsCompare Is Nothing Then
                Set wsCompare = wb1.Worksheets.Add
                wsCompare.Name = "Comparison"
            End If
            wsCompare.Range(Cells(1, 1), Cells(rw2, col2)).FormulaR1C1 = "='" & ws1.Name & "'!RC='" & ws2.Name & "'!RC"
            For rw1 = 1 To rw2
                For col1 = 1 To col2
                    If wsCompare.Cells(rw1, col1) = False Then
                        wsCompare.Cells(rw1, col1).Interior.Color = vbRed
                    End If
                Next col1
            Next rw1
        End If
    End If
    Exit Sub
    
ErrorExit:
    If Err.Number Then
        MsgBox "Unable to run the procedure" _
         & vbLf & "-Check that your initial range to compare is composed by SheetName + Range ex: Sheet1$A$1" _
         & vbLf & "-Check that your initial range to compare is different from both sheets involved by the comparison"
    End If
End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
LD16Author Commented:
Tested and it works! Thank you again for your help!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.