Macro to copy Table1 to the end of Table2...

[obiwilson]

I realize this question is similar to what is being asked here and here. However, when I tried to adapt them for my use I ran into several issues.

On worksheet "Free IDs" I have Table1 from A1:J21 with headers, data validation and formulas.
On worksheet "MASTER LIST" I have Table2 with the same headers and no data atm (I removed all the historical data as it was a mess)

There is a button on the bottom of worksheet "FREE IDs" which needs to perform the following:
- copy data from Table1 (minus the header) to the end of Table2.
- clear data from Table1 from B2:J21 but keep data validation, formulas and set background to no fill color.
or
- clear data from Table1 keeping data validation, formulas, set background to no fill and repopulate column A (A2:A21) with sequential numbers carrying on from what was cleared. So the previous A21+1 would be the new A2...

I have managed to do this, kind of, by recording a macro but it is a very ugly (Insert instead of xlup and loosing data validation...) way of doing it:

Sub CopyToMaster()
'
' CopyToMaster Macro
' copies the free ID table to the master table then resets the IDs.

    Range("A2:J21").Select
    Selection.Copy
    Sheets("MASTER LIST").Select
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown
    Sheets("Free IDs").Select
    Range("A21").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("A1:A21"), Type:=xlFillSeries
    Range("A1:A21").Select
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "ID"
    Range("A1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Range("B2:J21").Select
    Select

I know this can be done in an much more elegant way. Any help would be much appreciated.

 

[obiwilson]

Worksheet "Free IDs" Table1

DICTATION User Name Codes_test.xls
	A	B	C	D	E	F	G	H	I	J
1	ID	Surname	First Name	Title	Position	Unit	CODE	Email address	Username	Date Created
2	2731	McTester	John	Mr	Intern	ENT	3388		mctester	01/01/1990
3	2732
4	2733
5	2734
6	2735
7	2736
8	2737
9	2738
10	2739
11	2740
12	2741
13	2742
14	2743
15	2744
16	2745
17	2746
18	2747
19	2748
20	2749
21	2730
Free IDs

Cell Formulas
Range	Formula
G2:G21	G2	=IF(ISNA(LOOKUP('Free IDs'!F2,'Unit Codes'!A:A,'Unit Codes'!B:B)),"",LOOKUP('Free IDs'!F2,'Unit Codes'!A:A,'Unit Codes'!B:B))
I2:I21	I2	=LOWER('Unit Codes'!I2)

Named Ranges
Name	Refers To	Cells
'Unit Codes'!_FilterDatabase	='Unit Codes'!$A$1:$B$72	G2:G21

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
A1:A21	Cell Value	duplicates	text	YES

Cells with Data Validation
Cell	Allow	Criteria
D2:D21	List	='Unit Codes'!$D$2:$D$8
E2:E21	List	='Unit Codes'!$F$2:$F$8
F2:F21	List	='Unit Codes'!$A$2:$A$72

Worksheet "MASTER LIST" Table2

DICTATION User Name Codes_test.xls
	A	B	C	D	E	F	G	H	I	J
1	ID	Surname	First Name	Title	Position	Unit	CODE	Email address	Username	Date Created
2
MASTER LIST

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
A1	Cell Value	duplicates	text	YES
A2:A65536,O:O	Cell Value	duplicates	text	YES

 

[Alex Blakenburg]

You have only 1 row populated in FreeIds. Does that mean you only want 1 row copied to the Master List ?
And if that is the case does the numbering restart from 2732 and not 2751 (I am assuming the last 2730 s/be 2750) ?

 

[obiwilson]

You have only 1 row populated in FreeIds. Does that mean you only want 1 row copied to the Master List ?
And if that is the case does the numbering restart from 2732 and not 2751 (I am assuming the last 2730 s/be 2750) ?

Free IDs will be full when button is pressed (20 rows).
Yes, that should have been 2750 (I noticed after posting) so it would be restarting from 2751.

 

[Alex Blakenburg]

On a copy of your workbook, give this a try:

Sub CopyToMaster_v02()

    Dim shtMstr As Worksheet, shtFree As Worksheet
    Dim tblMstr As ListObject, tblFree As ListObject
    Dim mstrNewRow As ListRow
    Dim freeItemNoMax As Long
    Dim freeRng As Range
    
    Set shtMstr = Worksheets("MASTER LIST")
    Set tblMstr = Range("Table2").ListObject
    
    Set shtFree = Worksheets("Free IDs")
    Set tblFree = Range("Table1").ListObject

    Set mstrNewRow = tblMstr.ListRows.Add
    tblFree.DataBodyRange.Copy Destination:=mstrNewRow.Range
    
    freeItemNoMax = WorksheetFunction.Max(tblFree.ListColumns(1).Range)
    tblFree.DataBodyRange.Rows.Delete

    Set freeRng = tblFree.Range.Cells(1).Offset(1)
    freeRng = freeItemNoMax + 1
    freeRng.AutoFill Destination:=freeRng.Resize(21), Type:=xlFillSeries
    
    With tblFree.DataBodyRange.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With

End Sub

 

[obiwilson]

On a copy of your workbook, give this a try:

Sub CopyToMaster_v02()

    Dim shtMstr As Worksheet, shtFree As Worksheet
    Dim tblMstr As ListObject, tblFree As ListObject
    Dim mstrNewRow As ListRow
    Dim freeItemNoMax As Long
    Dim freeRng As Range
   
    Set shtMstr = Worksheets("MASTER LIST")
    Set tblMstr = Range("Table2").ListObject
   
    Set shtFree = Worksheets("Free IDs")
    Set tblFree = Range("Table1").ListObject

    Set mstrNewRow = tblMstr.ListRows.Add
    tblFree.DataBodyRange.Copy Destination:=mstrNewRow.Range
   
    freeItemNoMax = WorksheetFunction.Max(tblFree.ListColumns(1).Range)
    tblFree.DataBodyRange.Rows.Delete

    Set freeRng = tblFree.Range.Cells(1).Offset(1)
    freeRng = freeItemNoMax + 1
    freeRng.AutoFill Destination:=freeRng.Resize(21), Type:=xlFillSeries
   
    With tblFree.DataBodyRange.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With

End Sub

Thanks, it's close. I got this message box and following result:

I'm not worried about the colour, I can sort that out later. The number sequencing on Free IDs Table1 restarted at 1 and the table now extends down to row 22. I sorted the #REF! in username earlier so not sure what's broken there but I can probably work that out.

In MASTER LIST it didn't paste the CODE or USERNAME which cells are a formula, I think I used a special paste previously to get this to work.

Thanks for your help.

 

[Alex Blakenburg]

I can change the paste to be paste values but is there any chance you can share a copy of your workbook via a sharing platform eg dropbox, google drive etc. There has to be something different in your data to my test data, in terms of the number sequence not working and that it left a blank row on the destination table.
If you sanitise the data just test the macro on the cut down version to make sure the problem is still there so I can see it.

 

[obiwilson]

I can change the paste to be paste values but is there any chance you can share a copy of your workbook via a sharing platform eg dropbox, google drive etc. There has to be something different in your data to my test data, in terms of the number sequence not working and that it left a blank row on the destination table.
If you sanitise the data just test the macro on the cut down version to make sure the problem is still there so I can see it.

I just sent you a DM with a link. Thanks.

 

[Alex Blakenburg]

OK - please confirm if you are ok to do (1) manually and if you want me to change to paste values (item 4 below)
1) Column 1 in both tables (Column A) is formatted as TEXT
This is preventing the Max function from working.
I can handle it in code but its a OneOff so you are better off doing it manually once.
• Select Column A in the table > Change the format to General
• Goto Text to Tables > Delimited > Finish

2) "Insert Rows" Warning dialogue box
I will handle this in the code

3) Additional Blank when Master Table is empty
I will handle this in the code
Note: the best way to clear the table is to select all rows in the databody range and hit delete. This avoids the extra blank row issue
It looks like you have deleted all rows except row 1 and just cleared content on row 1

4) #REF issue
At the moment the code is doing a straight copy paste. This is not creating the REF issue since it already exists in FreeIDs.
However if you don't want the formulas in the Master, I can change the code to PasteSpecial values.

 

[obiwilson]

OK - please confirm if you are ok to do (1) manually and if you want me to change to paste values (item 4 below)
1) Column 1 in both tables (Column A) is formatted as TEXT
This is preventing the Max function from working.
I can handle it in code but its a OneOff so you are better off doing it manually once.
• Select Column A in the table > Change the format to General
• Goto Text to Tables > Delimited > Finish

2) "Insert Rows" Warning dialogue box
I will handle this in the code

3) Additional Blank when Master Table is empty
I will handle this in the code
Note: the best way to clear the table is to select all rows in the databody range and hit delete. This avoids the extra blank row issue
It looks like you have deleted all rows except row 1 and just cleared content on row 1

4) #REF issue
At the moment the code is doing a straight copy paste. This is not creating the REF issue since it already exists in FreeIDs.
However if you don't want the formulas in the Master, I can change the code to PasteSpecial values.

1) Yes, I have just done this. Just confirming it was Text to Column?
2) Thanks.
3) My bad. Worst still, I did that intentionally thinking it might help...
4) Yes, change to PasteSpecial as the formulas will return a different value once Table1 is repopulated with data.

Thanks.