Consolidating two worksheets onto a third worksheet

[mrzesty973]

Hi,


Trying to consolidate 2 worksheets that have invoice numbers and payment status onto one worksheet but having difficulty.


The solution shows the invoice numbers in ascending order and when a match is made the invoice numbers and their status should be put onto the same row. If a match is not made, then the word missing should be inserted.


Sample screen shot with three worksheets shows the two lists on AR & AP and the desired output on the tab called Recon.

AR List

Excel 2012

	A	B
1	Invoice Number	Status
2	A1	Unpaid
3	A4	Unpaid
4	A701	Unpaid
5	A2	Unpaid
6	A6	Waiting
7	A701	Unpaid

<colgroup><col style="width: 25pxpx"><col><col></colgroup><thead>
</thead><tbody>
</tbody>

AR​

AP List

Excel 2012

	A	B
1	Invoice Number	Status
2	A3	Paid
3	A701	Paid
4	A1	Paid
5	A5	Paid
6	A701	Paid
7	A6	Waiting

<colgroup><col style="width: 25pxpx"><col><col></colgroup><thead>
</thead><tbody>
</tbody>

AP​

Recon
Excel 2012

	A	B	C	D	E
1	AR Invoice	AR Status		AP Invoice	AP Status
2	A1	Unpaid		A1	Paid
3	A2	Unpaid		Missing	Missing
4	Missing	Missing		A3	Paid
5	A4	Unpaid		Missing	Missing
6	Missing	Missing		A5	Paid
7	A6	Waiting		A6	Waiting
8
9	AR Duplicates			AP Duplicates
10	A701	Unpaid		A701	Paid
11	A701	Unpaid		A701	Paid

<colgroup><col style="width: 25pxpx"><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>

Recon​

Thank you ahead of time for reading this post and any help.

 

[SQUIDD]

Hi

How are you hoping to acomplish this.
VBA?

Additioanally
Is the Recon Page how you wish your data to be laid out. With the duplicates under the unique instances with a 1 empty row between.

I assume your data actual data has far more rows than what you have posted.

Dave

 

[JLGWhiz]

See if you can use this. It uses a third sheet for the consolidated data.

Sub t()
Dim ary As Variant, fn As Range, i As Long, fAdr As String
Sheet1.Columns(1).Insert
Sheet1.Range("B2", Sheet1.Cells(Rows.Count, 2).End(xlUp)).Copy Sheet1.Range("A2")
Sheet2.Range("A2", Sheet2.Cells(Rows.Count, 1).End(xlUp)).Copy Sheet1.Cells(Rows.Count, 1).End(xlUp)(2)
Sheet1.Range("A1") = "x"
Sheet1.Range("A1", Sheet1.Cells(Rows.Count, 1).End(xlUp)).AdvancedFilter xlFilterCopy, , Sheet1.Cells(Rows.Count, 1).End(xlUp)(2), True
Sheet1.Range("A1").ClearContents
Set fn = Range(Sheet1.Range("A:A").Find("x", , xlValues), Sheet1.Cells(Rows.Count, 1).End(xlUp))
fn.Sort Sheet1.Cells(Rows.Count, 1).End(xlUp), xlAscending
'rw = fn.Rows(1).Row
ary = Application.Transpose(fn)
Sheet1.Columns(1).Delete
    For i = LBound(ary) To UBound(ary) - 1
            Set fn = Sheet1.Range("A:A").Find(ary(i), , xlValues, xlWhole)
            If Not fn Is Nothing Then
                fAdr = fn.Address
                    Do
                    Sheet3.Cells(Rows.Count, 1).End(xlUp)(2) = fn.Value
                    Sheet3.Cells(Rows.Count, 1).End(xlUp).Offset(, 1) = fn.Offset(, 1).Value
                    Set fn = Sheet1.Range("A:A").FindNext(fn)
                    Loop While fn.Address <> fAdr
            Else
                Sheet3.Cells(Rows.Count, 1).End(xlUp)(2) = "Missing"
            End If
        Set fn = Sheet2.Range("A:A").Find(ary(i), , xlValues, xlWhole)
            If Not fn Is Nothing Then
                fAdr = fn.Address
                    Do
                    Sheet3.Cells(Rows.Count, 3).End(xlUp)(2) = fn.Value
                    Sheet3.Cells(Rows.Count, 3).End(xlUp).Offset(, 1) = fn.Offset(, 1).Value
                    Set fn = Sheet2.Range("A:A").FindNext(fn)
                    Loop While fn.Address <> fAdr
            Else
                Sheet3.Cells(Rows.Count, 3).End(xlUp)(2) = "Missing"
            End If
    Next
End Sub