VBA Code that gives results in MsgBox

Status
Not open for further replies.

KrystynaD

New Member
Joined
Feb 11, 2020
Messages
10
Office Version
  1. 365
Platform
  1. MacOS
Ideally I would like the message box to display whether any discrepancies were identified in sheet 3.

The data in sheet 1&2 should be identical, so when the macro is run the results in sheet 3 should show no data because there is no discrepancy. Now, if there are discrepancies between the data in sheet 1 and sheet 2, sheet 3 will show those discrepancies and highlight them. (I have uploaded the image of Sheet 3 to show what that looks like. The data highlighted in Orange, at the top, is the correct data from sheet 1, and the data highlighted in Yellow, under the title Sheet 2 V Sheet 1, is the data with the discrepancies in sheet 2). Once the macro has been run i would like a message box at the end that returns the result of "x" discrepancies were identified (if we use the example of sheet 3 - the uploaded image- the message box would say 2 discrepancies were identified, but if there were no discrepancies identified between sheet 1 and sheet 2 then the message box would say no discrepancies were identified).


VBA Code:
Sub LookForDiscrepancies()
    Dim varS1, varS2, varH1, varH2
    Dim rngS1 As Range, rngS2 As Range
    Dim c As Range, c1 As Range, c2 As Range
    Dim iRow As Integer, iCol As Integer, i As Integer, iTest As Integer
    
    Sheet1.Activate
    Set rngS1 = Intersect(Sheet1.UsedRange, Columns("A"))
    Sheet2.Activate
    Set rngS2 = Intersect(Sheet2.UsedRange, Columns("A"))
    Sheet3.Activate
    Sheet3.Cells.Select
    Ans = MsgBox(prompt:="Do you really want to delete data in Sheet3?", _
Buttons:=vbYesNo + vbExclamation, _
Title:="Delete Data!")

If Ans = vbNo Then Exit Sub ' vbNo = 7, vbYes = 6


    Selection.Delete Shift:=xlUp
    Sheet3.Rows("1:1").Value = Sheet1.Rows("1:1").Value
    
    Let iRow = iRow + 2
    With rngS2
         'Search for Sheet1 IDs on Sheet2
        For Each c1 In rngS1
            On Error GoTo 0
            Set c = .Find(what:=c1.Value) 'Look for match
            If c Is Nothing Then 'Copy the ID to Sheet3
                Sheet3.Cells(iRow, 1) = c1
                Sheet3.Cells(iRow, 2) = "exist in sheet 1 not in sheet 2"
                Let iRow = iRow + 1
                Else 'Check if rows are identical
                Let varS1 = Intersect(Sheet1.UsedRange, c1.EntireRow)
                Let varS2 = Intersect(Sheet2.UsedRange, c.EntireRow)
                Let iCol = Intersect(Sheet1.UsedRange, c1.EntireRow).Count
                ReDim varH1(1 To iCol) As Integer
                For i = 1 To iCol
                    If Not varS1(1, i) = varS2(1, i) Then
                        Let iTest = iTest + 1
                        Let varH1(i) = 1
                    End If
                Next i
                If iTest Then 'Rows are not identical
                    For i = 1 To iCol
                        Sheet3.Cells(iRow, i) = varS1(1, i)
                        If Not varH1(i) = 0 Then Cells(iRow, i) _
                        .Interior.ColorIndex = 40
                    Next i
                    Let iTest = 0
                    Let iRow = iRow + 1
                End If
            End If
        Next
    End With
    
    Let iRow = iRow + 0
    Range("A1").Offset(iRow, 0).Value = "Sheet2 vs Sheet1"
    Let iRow = iRow + 2
        With rngS1
         'Search for Sheet2 IDs on Sheet1
        For Each c2 In rngS2
            On Error GoTo 0
            Set c = .Find(what:=c2.Value) 'Look for match
            If c Is Nothing Then 'Copy the ID to Sheet3
                Sheet3.Cells(iRow, 1) = c2
                Sheet3.Cells(iRow, 2) = "exist in sheet 2 not in sheet 1"
                Let iRow = iRow + 1
                Else 'Check if rows are identical
                Let varS1 = Intersect(Sheet2.UsedRange, c2.EntireRow)
                Let varS2 = Intersect(Sheet1.UsedRange, c.EntireRow)
                Let iCol = Intersect(Sheet2.UsedRange, c2.EntireRow).Count
                ReDim varH2(1 To iCol) As Integer
                For i = 1 To iCol
                    If Not varS1(1, i) = varS2(1, i) Then
                        Let iTest = iTest + 1
                        Let varH2(i) = 1
                    End If
                Next i
                If iTest Then 'Rows are not identical
                    For i = 1 To iCol
                        Sheet3.Cells(iRow, i) = varS1(1, i)
                        If Not varH2(i) = 0 Then Cells(iRow, i) _
                        .Interior.ColorIndex = 36
                        Next i
                    Let iTest = 0
                    Let iRow = iRow + 1
                    End If
            End If
        Next
    End With
     Sheet3.Select 'resize the columns
     Range("A:Z").Columns.AutoFit
        
End Sub
 

Attachments

  • Screenshot 2020-03-15 at 17.13.48.png
    Screenshot 2020-03-15 at 17.13.48.png
    152.5 KB · Views: 18

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Duplicate post
 
Upvote 0
Please do not post the same question multiple times. Questions of a duplicate nature will be locked or deleted, per #12 of the Forum Rules and points 6 & 7 of the Guidelines.

Any bumps, clarifications, or follow-ups should be posted to your original thread.
 
Upvote 0
Status
Not open for further replies.

Forum statistics

Threads
1,215,004
Messages
6,122,659
Members
449,091
Latest member
peppernaut

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top