Compare Table A & B and insert differences in between rows in Table B

Ashkelon

New Member
Joined
Dec 19, 2020
Messages
19
Office Version
  1. 365
Platform
  1. Windows
Hi everyone, I've attached sample tables and code below to help better visualize my problem. Each week, I run a program to update my database ("Table A") with data from "Table B". Part of it prompts the user to enter the week's number, filters "Table B" according to the input and then copies over the visible rows to Table A.

Lets say that in Week 5, after already running the macro, i see that one new Week 4 entry was retroactively added to ("Table B"). I would like to add this new row of data below the last Week 4 entry in Table A but before Week 5 to make it consistent. The intended result is shown in "Ideal Result" sheet.

In other words, i'm trying to figure out how to:
  1. Compare the visible rows in Table A and the entire database in Table B using the values in Column D (there is no primary key in the rows of data),
  2. Find the non-duplicates in Table A,
  3. And then copy & pasting them below the specified week's entry in Table B
Is it possible with VBA?

Sample.xlsm
ABCDE
1Account NoAccount NameAmountWeekClient Name
21001Company A2453Dec20 Week4Tom
31002Company B158Dec20 Week4Bob
41003Company C340Dec20 Week4Harry
51005Company D141Dec20 Week5James
61006Company F1550Dec20 Week5Robert
Table A
Sample.xlsm
ABCDE
1Account NoAccount NameAmountWeekClient Name
21001Company A2453Dec20 Week4Tom
31002Company B158Dec20 Week4Bob
41003Company C340Dec20 Week4Harry
51004Company D158Dec20 Week4John
Table B
Sample.xlsm
ABCDE
1Account NoAccount NameAmountWeekClient Name
21001Company A2453Dec20 Week4Tom
31002Company B158Dec20 Week4Bob
41003Company C340Dec20 Week4Harry
51004Company D158Dec20 Week4John
61005Company E141Dec20 Week5James
71006Company F1550Dec20 Week5Robert
Ideal Result

VBA Code:
Public Sub CopyData()

Set TableA = ThisWorkbook.Worksheets(1)
Set TableB = ThisWorkbook.Worksheets(2)
LastRowOfTableB = TableB.Range("B" & Rows.Count).End(xlUp).Row

'Filters Table A according to user input
    Do
        myValue = InputBox("Which week's data do you wish to copy over?" & vbCrLf & "Enter 1, 2, 3, 4 or 5 only")
        If myValue = "" Then Exit Sub
    Loop Until myValue > 0 And myValue < 6
                             
            If myValue = 4 Then
            TableA.Range("A4").CurrentRegion.AutoFilter Field:=4, Criteria1:= _
                    "* Week4"
            ElseIf myValue = 5 Then
            TableA.Range("A4").CurrentRegion.AutoFilter Field:=4, Criteria1:= _
                    "* Week5"
            End If
'Copies the Filtered Data Over
TableA.Range("A2:X200").SpecialCells(xlCellTypeVisible).Copy _
  TableB.Range("A" & LastRowOfTableB)
End Sub
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

Forum statistics

Threads
1,214,988
Messages
6,122,620
Members
449,092
Latest member
amyap

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