asked on

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

Fabrice Lambert

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.

Luis Diaz

ASKER

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 Hedegaard

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

Luis Diaz

ASKER

Thank you very much for this proposal. I will take the the time to test it today.

Luis Diaz

ASKER

I just performed a test and I have the following error message:

Related to the following line:

Thank you in advance for your help.

Fabrice Lambert

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 Hedegaard

Forgot the set instruction on that line, just add it.

@Fabrice
What do you mean by "break the SRP"

Fabrice Lambert

@Ejgil Hedegaard:
Single Responsibility Principle.

A class or function should have one, and only one responsibility, so it is easyer to understand and maintain.

Luis Diaz

ASKER

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:

I 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"

ASKER CERTIFIED SOLUTION

Ejgil Hedegaard

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Luis Diaz

ASKER

Tested and it works! Thank you again for your help!