How to duplicate rows in table in Excel - vba

Question

I need to create a macro that will duplicate all the rows of a table when a certain column is true.
I recorded a macro and it gave me this:
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=4, Criteria1:= "TRUE"
Range("Table1").Select
Application.CutCopyMode = False
Selection.Copy
Range("A22").Select 'To be replaced with a method that finds the last cell.
'Selection.End(xlDown).Select gives me the last row in the table, but I want the one under that.
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=12
However before I delve into it I would like to know what would be the best/fastest approach?

Answer 1

Something like this would work. Modify as needed
Sub david()
Application.CutCopyMode = True
Dim lastrow As Integer
Dim rCell As Range
lastrow = ActiveSheet.ListObjects("Table1").ListRows.Count
For Each rCell In ActiveSheet.ListObjects("Table1").ListColumns(2).DataBodyRange
If rCell.Value = "True" Then
ActiveSheet.ListObjects("Table1").ListRows.Add
rCell.EntireRow.Copy
ActiveSheet.ListObjects("Table1").ListRows(lastrow + 1).Range.PasteSpecial Paste:=xlPasteValues
lastrow = lastrow + 1
End If
Next
Application.CutCopyMode = False
End Sub
If you have other data on the same row in the table's sheet, you might need to copy a specific range rather than .entirerow as it will pick up data outside the table.
These two SO threads may help if you want to clean it up some- Copy and Paste Table Row and Add row.

Answer 2

I ended up writing this, much faster. There's some logic which avoids copying the first column (which is a Row() formula. You can probably do without it).
Sub DuplicateRows(tableToDuplicate As String, columnToDetermineIfRowNeedsDuplication As Integer)
Application.DisplayAlerts = False
'Excel is more efficient when copying whole ranges at once rather than row by row.
Dim sourceRange As Range, destRange As Range
Dim rowsToDelete As Range
Set sourceRange = Range(tableToDuplicate)
'Copy source range except row num. Start at bottom of source range. Start at offset x + so that row number is not copied.
Set sourceRange = sourceRange.Resize(sourceRange.Rows.Count, sourceRange.Columns.Count - 1)
Set sourceRange = sourceRange.Offset(0, 1) ' We don't need to copy the first column.
Set destRange = sourceRange.Offset(sourceRange.Rows.Count, 0)
destRange.Value = sourceRange.Value 'Duplicate all values.
Set rowsToDelete = destRange 'Get complete table now, unfiltered.
rowsToDelete.AutoFilter columnToDetermineIfRowNeedsDuplication, Criteria1:="=FALSE" ' Find which ones we must delete.
Set rowsToDelete = rowsToDelete.Offset(0, -1)
Set rowsToDelete = rowsToDelete.Resize(rowsToDelete.Rows.Count, rowsToDelete.Columns.Count + 1)
rowsToDelete.Rows.Delete
End Sub