VBA to Compare Two Worksheets Based on Multiple Columns and Output Results to User Built Template

[goob90]

Hello everyone!



I am working on simplifying our employee benefit reconcile process at work. With over 500 employees and 16 different enrollment options, the current reconcile process is messy and prone to errors.



I've created a flow in Power Automate Desktop (PAD) that allows the user to upload a payroll report and carrier invoice. The flow cleans up the data from the two files and writes and saves it to an Excel Workbook. I plan to use PAD to manipulate Macro Enabled Worksheet and heavily reduce the amount of user input.



That being said, the workbook has two sheets, a payroll report and carrier invoice.



I am wanting to use VBA/Macro to compare both worksheets and export the variances to a template I built. I know there are a ton of posts on comparing two sheets, but I am needing the VBA to look at several columns to make comparisons.



For instance, an employee may be listed twice on the payroll report. Once for their health premium and once for their dental. The same can be said about the carrier invoice.



I need the VBA to look at the "Employee ID" column between both sheet and then look at the "Product Column" to see if it's for health or dental. Once it matches those two criteria, I need it to look at the "Cost" to see if there is a variance.



There should only be 3 things that would cause an employee to be on the variance sheet:

• The employee is on the payroll report but not on the invoice.
• The employee is on the invoice but not on the payroll report.
• There is a difference in what payroll deduction amount and what was on the carrier invoice. (Ideally, I would have it only show differences that were greater than$1.00)

Sheet One- Payroll Report

Sample Reconcile (1).xlsx
	A	B	C	D	E	F	G
1	First Name	Last Name	Employee ID	Product	Employee Portion	Employer Portion	Total Premium
2	Luke	Skywalker	1976	Health	$ 25.00	$ 475.00	$ 500.00
3	Luke	Skywalker	1976	Dental	$ 4.50	$ 25.50	$ 30.00
4	Egon	Spengler	1984	Dental	$ 4.50	$ 25.50	$ 30.00
5	Lloyd	Christmas	1994	Health	$50	$650	$700
6	Lloyd	Christmas	1994	Dental	$6	$34	$40
7	Clark	Griswald	1983	Health	$80	$ 820.00	$900
Sample Payroll Report

Cell Formulas
Range	Formula
G2:G7	G2	=SUM(E2,F2)

Sheet Two- Carrier Invoice

Sample Reconcile (1).xlsx
	A	B	C	D	E
1	First Name	Last Name	Employee ID	Product	Total Premium
2	Luke	Skywalker	1976	Health	$ 600.00
3	Luke	Skywalker	1976	Dental	$ 30.00
4	Egon	Spengler	1984	Dental	$ 30.00
5	Lloyd	Christmas	1994	Health	$ 700.00
6	Lloyd	Christmas	1994	Dental	$ 40.00
7	Peter	McCallister	1990	Health	$ 800.00
8	Peter	McCallister	1990	Dental	$ 100.00
Sample Carrier Invoice

New Workbook with Results

Sample Reconcile (1).xlsx
	A	B	C	D	E	F	G	H
1	First Name	Last Name	SSN	Product	Payroll Deduction	Inoivce Amount	Difference	Notes
2	Luke	Skywalker	1976	Health	$ 1,976.00	$ 600.00	$ (1,376.00)
3	Clark	Griswald	1983	Health	$ 900.00		$ (900.00)	Missing from Invoice
4	Peter	McCallister	1990	Health		$ 800.00	$ 800.00	Missing Payroll Deduction
5	Peter	McCallister	1990	Dental		$ 100.00	$ 100.00	Missing Payroll Deduction
Reconcile

Cell Formulas
Range	Formula
E2	E2	=SUM(C2,D2)
G2:G5	G2	=F2-E2

 

[igold]

Trying to work this but I am unclear on how you are coming up with the below Column E. The $1976.00 Payroll deduction cannot be calculated with any of the given data (the formula relates to nothing other than the SSN minus nothing). If it is something that your PAD is spitting out, and you don't want the VBA to look at, then what logic would the VBA use, to know that Egon Spengler is not an exceptional employee.
I hope the issue I am trying to explain makes sense.

Reconcile.xlsm
	A	B	C	D	E	F	G	H
1	First Name	Last Name	SSN	Product	Payroll Deduction	Inoivce Amount	Difference	Notes
2	Luke	Skywalker	1976	Health	$ 1,976.00	$ 600.00	-1376
3	Clark	Griswald	1983	Health	$ 900.00		-900	Missing from Invoice
4	Peter	McCallister	1990	Health		$ 800.00	800	Missing Payroll Deduction
5	Peter	McCallister	1990	Dental		$ 100.00	100	Missing Payroll Deduction
Reconcile

Cell Formulas
Range	Formula
E2	E2	=SUM(C2,D2)
G2:G5	G2	=F2-E2

 

[goob90]

Trying to work this but I am unclear on how you are coming up with the below Column E. The $1976.00 Payroll deduction cannot be calculated with any of the given data (the formula relates to nothing other than the SSN minus nothing). If it is something that your PAD is spitting out, and you don't want the VBA to look at, then what logic would the VBA use, to know that Egon Spengler is not an exceptional employee.
I hope the issue I am trying to explain makes sense.

Reconcile.xlsm
	A	B	C	D	E	F	G	H
1	First Name	Last Name	SSN	Product	Payroll Deduction	Inoivce Amount	Difference	Notes
2	Luke	Skywalker	1976	Health	$ 1,976.00	$ 600.00	-1376
3	Clark	Griswald	1983	Health	$ 900.00		-900	Missing from Invoice
4	Peter	McCallister	1990	Health		$ 800.00	800	Missing Payroll Deduction
5	Peter	McCallister	1990	Dental		$ 100.00	100	Missing Payroll Deduction
Reconcile

Cell Formulas
Range	Formula
E2	E2	=SUM(C2,D2)
G2:G5	G2	=F2-E2

It's honestly a mistake and shouldn't show $1,976 (mistakenly copied over 1976 from the employee #). I meant for it to just show the sum of "Total Premium (Column G ) from the Sample Payroll Report and the "Total Premium" (Column E) from the Sample Carrier Invoice.

So, ideally it would show a $100 difference, since Luke had a $500 premium on the payroll report but shows he will charged $600 on the carrier invoice.

I also didn't mean to include any formulas in my example.

 

[igold]

Given the data you posted in your Post #1, this code tested and worked.

Sub recon()

    Dim wsPR As Worksheet: Set wsPR = Worksheets("Sample Payroll Report")
    Dim wsCI As Worksheet: Set wsCI = Worksheets("Sample Carrier Invoice")
    Dim wsR As Worksheet: Set wsR = Worksheets("Reconcile")
    Dim arrP, arrC, arrA, i As Long, ii As Long, x As Long, d As Long
    Dim lRowPay As Long, lRowCar As Long, r As Long
   
    Application.ScreenUpdating = False
    lRowPay = wsPR.Cells(Rows.Count, 3).End(xlUp).Row
    lRowCar = wsCI.Cells(Rows.Count, 3).End(xlUp).Row
    arrP = wsPR.Range("A2:H" & lRowPay)
    arrC = wsCI.Range("A2:H" & lRowCar)
   
    ReDim arrA(1 To UBound(arrP) + UBound(arrC), 1 To 8)
   
    For i = 1 To UBound(arrP)
        arrP(i, 5) = arrP(i, 5) + arrP(i, 6)
        arrP(i, 7) = arrP(i, 3) & arrP(i, 4)
        arrP(i, 6) = ""
        arrP(i, 8) = "P"
        For d = 1 To 8
            arrA(i, d) = arrP(i, d)
        Next
    Next

    ReDim Preserve arrP(1 To UBound(arrP), 1 To 6)

    For i = 1 To UBound(arrC)
        arrC(i, 7) = arrC(i, 3) & arrC(i, 4)
        arrC(i, 6) = arrC(i, 5)
        arrC(i, 5) = ""
        arrC(i, 8) = "C"
    Next

    i = lRowPay - 1: x = 0
    For ii = 1 To UBound(arrC)
        If i + ii > UBound(arrA) Then Exit For
        For d = 1 To 8
            arrA(ii + i, d) = arrC(ii, d)
        Next
    Next

    For r = 1 To UBound(arrP)
        For x = 0 To lRowPay
            If x + lRowPay > UBound(arrA) Then Exit For
            If arrA(r, 7) = arrA(x + lRowPay, 7) Then
                arrA(r, 6) = arrA(x + lRowPay, 6)
                arrA(r, 7) = arrA(r, 5) - arrA(r, 6)
                arrA(x + lRowPay, 7) = 0
                Exit For
            End If
        Next
    Next
   
    For i = 1 To UBound(arrA)
        If IsNumeric(arrA(i, 7)) Then
            If arrA(i, 7) <> 0 Then arrA(1, 8) = "Invoice/Deduction Discrepancy"
        End If
    Next
   
    For i = 1 To UBound(arrA)
        If Not IsNumeric(arrA(i, 7)) Then
            If arrA(i, 8) = "P" Then
                arrA(i, 8) = "Missing From Invoice"
                arrA(i, 7) = arrA(i, 5)
            End If
            If arrA(i, 8) = "C" Then
                arrA(i, 8) = "Missing Payroll Deduction"
                arrA(i, 7) = arrA(i, 6)
            End If
        End If
    Next
     For i = 1 To UBound(arrA)
         If arrA(i, 7) = 0 Then arrA(i, 7) = ""
     Next
    
    wsR.Range("A2").Resize(UBound(arrA, 1), UBound(arrA, 2)) = arrA
    wsR.Columns("G").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Application.ScreenUpdating = True
   
End Sub

 

[goob90]

Given the data you posted in your Post #1, this code tested and worked.

Sub recon()

    Dim wsPR As Worksheet: Set wsPR = Worksheets("Sample Payroll Report")
    Dim wsCI As Worksheet: Set wsCI = Worksheets("Sample Carrier Invoice")
    Dim wsR As Worksheet: Set wsR = Worksheets("Reconcile")
    Dim arrP, arrC, arrA, i As Long, ii As Long, x As Long, d As Long
    Dim lRowPay As Long, lRowCar As Long, r As Long
  
    Application.ScreenUpdating = False
    lRowPay = wsPR.Cells(Rows.Count, 3).End(xlUp).Row
    lRowCar = wsCI.Cells(Rows.Count, 3).End(xlUp).Row
    arrP = wsPR.Range("A2:H" & lRowPay)
    arrC = wsCI.Range("A2:H" & lRowCar)
  
    ReDim arrA(1 To UBound(arrP) + UBound(arrC), 1 To 8)
  
    For i = 1 To UBound(arrP)
        arrP(i, 5) = arrP(i, 5) + arrP(i, 6)
        arrP(i, 7) = arrP(i, 3) & arrP(i, 4)
        arrP(i, 6) = ""
        arrP(i, 8) = "P"
        For d = 1 To 8
            arrA(i, d) = arrP(i, d)
        Next
    Next

    ReDim Preserve arrP(1 To UBound(arrP), 1 To 6)

    For i = 1 To UBound(arrC)
        arrC(i, 7) = arrC(i, 3) & arrC(i, 4)
        arrC(i, 6) = arrC(i, 5)
        arrC(i, 5) = ""
        arrC(i, 8) = "C"
    Next

    i = lRowPay - 1: x = 0
    For ii = 1 To UBound(arrC)
        If i + ii > UBound(arrA) Then Exit For
        For d = 1 To 8
            arrA(ii + i, d) = arrC(ii, d)
        Next
    Next

    For r = 1 To UBound(arrP)
        For x = 0 To lRowPay
            If x + lRowPay > UBound(arrA) Then Exit For
            If arrA(r, 7) = arrA(x + lRowPay, 7) Then
                arrA(r, 6) = arrA(x + lRowPay, 6)
                arrA(r, 7) = arrA(r, 5) - arrA(r, 6)
                arrA(x + lRowPay, 7) = 0
                Exit For
            End If
        Next
    Next
  
    For i = 1 To UBound(arrA)
        If IsNumeric(arrA(i, 7)) Then
            If arrA(i, 7) <> 0 Then arrA(1, 8) = "Invoice/Deduction Discrepancy"
        End If
    Next
  
    For i = 1 To UBound(arrA)
        If Not IsNumeric(arrA(i, 7)) Then
            If arrA(i, 8) = "P" Then
                arrA(i, 8) = "Missing From Invoice"
                arrA(i, 7) = arrA(i, 5)
            End If
            If arrA(i, 8) = "C" Then
                arrA(i, 8) = "Missing Payroll Deduction"
                arrA(i, 7) = arrA(i, 6)
            End If
        End If
    Next
     For i = 1 To UBound(arrA)
         If arrA(i, 7) = 0 Then arrA(i, 7) = ""
     Next
   
    wsR.Range("A2").Resize(UBound(arrA, 1), UBound(arrA, 2)) = arrA
    wsR.Columns("G").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Application.ScreenUpdating = True
  
End Sub

Thank you so much!

I saw you helped me with my pivot table question too. I appreciate it!

 

[igold]

You're welcome, I was happy to help. Thanks for the feedback!

Please mark the post that answered your question as the solution to help future readers. Little check mark icon on the right side of the post.

 

[abdelfattah]

@igold just , question why your code delete formatting cells ?

 

[igold]

@igold just , question why your code delete formatting cells ?

I am extensively using arrays, and arrays do not pick up any formatting, only values from the source data. Likewise they normally will not pick up any formulas.

 

[abdelfattah]

I am extensively using arrays, and arrays do not pick up any formatting, only values from the source data. Likewise they normally will not pick up any formulas.

what I meant when create formatting manually in third sheet and run the code will delete formatting in third sheet .
I'm not talking about brings the values with formatting cells ,formulas from others sheets .

 

[igold]

If your third sheet is formatted before the code is run, the code should not change the format. I don't know what your data looks like, nor do I know how many rows are being moved to the third sheet. What may be happening is that you have a format on your third sheet from rows 1 to 50. You then run the code and it writes 200 rows to your third sheet, then the code deletes the rows that match the criteria from this line at the bottom of the code:

 wsR.Columns("G").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

The code could be deleting all 50 of your formatted rows leaving you with unformatted rows.
Did you try applying your formats to the entire third sheet (using the select all button in the top left corner between the "1" and the "A") before the code is run. Again I am just throwing darts here, as I do not know anything about your data.