Comparing tables and printing discrepancies

Here's my first VBA project. I have some very limited Python experience, and this is my first VBA project. I'm sure I could have done it a lot more simply, but I just stuck with what I knew, and googled what I didn't, so feedback is very welcome.

The basic purpose is to compare a table from one sheet (OP) with a table from another (Payroll) and print the discrepancies in a third sheet (Results).

One last thing I want to do, but can't figure out (without using GoTo, which I read is bad) is to protect the worksheets after I Exit Sub on lines 22, 31, etc. (code for protecting sheets is already written in line 130 - 138.

```
Sub Macro1()

Dim counter As Integer
Set OPdata = New Dictionary
Set Payrolldata = New Dictionary
Set HRIDnames = New Dictionary

'Unprotects sheets
Worksheets("Results").Unprotect Password:=""
Worksheets("OP").Unprotect Password:=""
Worksheets("Payroll").Unprotect Password:=""

' Clears Results worksheet
Worksheets("Results").Activate
Range("A3:L10000").ClearContents

' Looks for missing data in the OP worksheet
Worksheets("OP").Activate
Range("A2").Select
If IsEmpty(ActiveCell) Then
MsgBox "There is data missing"
Exit Sub
End If

Worksheets("OP").Activate
Range("A1").CurrentRegion.Select
For Each C In Selection
If C = "" Then
C.Select
MsgBox "There is data missing"
Exit Sub
End If
Next

' Looks for missing data in the Payroll worksheet
Worksheets("Payroll").Activate
Range("A2").Select
If IsEmpty(ActiveCell) Then
MsgBox "There is data missing"
Exit Sub
End If

Worksheets("Payroll").Activate
Range("A1").CurrentRegion.Select
For Each C In Selection
If C = "" Then
C.Select
MsgBox "There is data missing"
Exit Sub
End If
Next

' Populate OPdata dictionary
Worksheets("OP").Activate
Range("A2", ActiveCell.End(xlDown)).Select
For Each cl In Selection
OPdata.Add cl.Value, cl.Offset(0, 2).Value & " " & cl.Offset(0, 3).Value
HRIDnames.Add cl.Value, cl.Offset(0, 1).Value
Next

' Populate Payrol

• Always put Option Explicit at the top of your modules (Tools - Options - Editor - Require Variable Declaration).

• Never select or activate something unless it's necessary

• Limit reading and writing to worksheets as it's an expensive operations

• When you have code that looks similar to other code, move it to another procedure

Here's some revised code

```
Sub Macro2()

Dim dcOp As Scripting.Dictionary, dcPay As Scripting.Dictionary, dcHri As Scripting.Dictionary
Dim shPay As Worksheet, shOp As Worksheet, shResults As Worksheet
Dim vaWrite As Variant
Dim vKey As Variant
Dim lCnt As Long
Dim bFail As Boolean

'The only acceptable use of goto imho
On Error GoTo ErrHandler

Set dcOp = New Scripting.Dictionary
Set dcPay = New Scripting.Dictionary
Set dcHri = New Scripting.Dictionary

'Set sheet variables so that if a sheet name changes, you only
'have to change it in one place. Or better yet, refer to sheets
'by their codename
Set shPay = Worksheets("Payroll")
Set shOp = Worksheets("OP")
Set shResults = Worksheets("Results")

shPay.Unprotect ""
shOp.Unprotect ""
shResults.Unprotect ""

' Clears Results worksheet
'Don't activate a sheet if you don't need to
shResults.Range("A3:L10000").ClearContents

' Looks for missing data in the OP worksheet
'Value is the default property of Range, but always use it for clarity
'By raising an error, you invoke the error handler where you can do
'things like protect sheets
If IsEmpty(shOp.Range("A2").Value) Or IsEmpty(shPay.Range("A2").Value) Then
Err.Raise 9999, , "There is data missing"
End If

'Repeating code should be factored out to a different function or sub
If DataMissing(shOp.Range("A1").CurrentRegion) Or DataMissing(shPay.Range("A1").CurrentRegion) Then
Err.Raise 9999, , "There is data missing"
End If

' Populate OPdata dictionary
GetData shOp, dcOp, dcHri
GetData shPay, dcPay, dcHri

vaWrite = GetUnique(dcOp, dcPay, dcHri, bFail)
shResults.Range("A3").Resize(UBound(vaWrite, 1), UBound(vaWrite, 2)).Value = vaWrite

vaWrite = GetUnique(dcPay, dcOp, dcHri, bFail)
shResults.Range("E3").Resize(UBound(vaWrite, 1), UBound(vaWrite, 2)).Value = vaWrite

'Find salary discrepencies.
'If you're going to fill cells one-by-one, don't activate them, just offset
For Each vKey In dcOp.Keys
If dcPay.Exists(vKey) Then
If dcOp.Item(vKey) <> dcPay.Item(vKey) Then
bFail = True
With shResults.Range("I3")
.Offset(lCnt, 0).Value = vKey
If dcHri.Exists(vKey) Then
.Offset(lCnt, 1).Value = dcHri.Item(vKey)
End If
.Offset(lCnt, 2).Value = dcPay.Item(vKey)
.Offset(lCnt, 3).Value = dcOp.Item(vKey)
End With
lCnt = lCnt + 1
End If
End If
Next vKey

If Not bFail Then MsgBox "Congratulations! OurPeople and Payroll reconcile exactly!"

ErrExit:
'If no errors, this executes. If there are errors, ErrHandler resumes execution here
'so the sheets get protected no matter what
shOp.Protect
shPay.Protect
shResults.Protect
Exit Sub 'single point of exit from the sub

ErrHandler:
'Err.Raise comes here
MsgBox Err.Description
Resume ErrExit

End Sub

Private Function DataMissing(rRng As Range) As Boolean

Dim rBlanks As Range

On Error Resume Next
Set rBlanks = rRng.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

DataMissing = Not rBlanks Is Nothing

End Function

Private Sub GetData(sh As Worksheet, ByRef dcData As Scripting.Dictionary, ByRef dcExcept As Scripting.Dictionary)
'ByRef means that whatever changed you make to the variable will still be there
'when you get back to the calling procedure

Dim vaData As Variant
Dim i As Long 'VB converts all integers to Long anyway, so just use Long

'Read data once in a big chunk rather than cell-by-cell
vaData = sh.Range("A2", sh.Range("A2").End(xlDown)).Resize(, 3).Value

For i = LBound(vaData, 1) To UBound(vaData, 1)
dcData.Add vaData(i, 1), vaData(i, 3) & Space(1) & vaData(i, 4)
If Not dcExcept.Exists(vaData(i, 1)) Then
dcExcept.Add vaData(i, 1), vaData(i, 2)
End If
Next i

End Sub

Private Function GetUnique(dcFirst As Scripting.Dictionary, dcLast As Scripting.Dictionary, dcNames As Scripting.Dictionary, ByRef bFail As Boolean) As Variant

Dim aReturn() As Variant
Dim lCnt As Long
Dim vKey As Variant

ReDim aReturn(1 To dcFirst.Count, 1 To 3)

For Each vKey In dcFirst.Keys
If Not dcLast.Exists(vKey) Then
bFail = True
lCnt = lCnt + 1
aReturn(lCnt, 1) = vKey
If dcNames.Exists(vKey) Then aReturn(lCnt, 2) = dcNames.Item(vKey)
aReturn(lC

StackExchange Code Review Q#32564, answer score: 10