wimgielis.com

Duplicate the current row automatically

• Nov. 4, 2015

	Example files with this article:
	Duplicate row

Introduction

Today I would like to show you a macro that I use every day, several times. With that macro you can duplicate the currently selected row in an Excel worksheet. This macro not only works in a regular Excel worksheet, but also when the active cell is part of an Excel table (ListObject). The big advantage is that you can quickly copy a row and change where needed.

Examples

Here are examples:

We click at cell C7, for example, because every cell in the row is fine for the macro. After that a macro will take row 7 and copy it by inserting as a new row below the currently selected row 7. The explanation is not easy but I bet the screenshots are clear.

VBA code

Following the text is the VBA code, but you can also see the code in the example file at the top of the page. You will notice in the code that I test whether the selection (active cell) is part of a ListObject ir not. If yes, the code is less straightforward.

Sub DuplicateRow()
' Wim Gielis
' https://www.wimgielis.com
'''''
' Procedure to duplicate the current row
' 04/11/2016
'''''
    Dim lRow                  As Long
    Dim li                    As ListObject
    Dim rngStart              As Range

    If TypeName(Selection) = "Range" Then

        Set rngStart = Selection.Cells(1)

        lRow = rngStart.Row

        If lRow < Rows.Count Then

            Application.ScreenUpdating = False

            If rngStart.ListObject Is Nothing Then

                'non-data table case

                '==> duplicate the selected row
                Rows(lRow).Copy
                Rows(lRow + 1).Insert Shift:=xlDown
                Rows(lRow + 1).RowHeight = Rows(lRow).RowHeight
                rngStart.Offset(1).Select

            Else

                'data table case

                Set li = rngStart.ListObject

                If li.SourceType = xlSrcRange Then

                    'turn off filters if applicable
                    If li.AutoFilter.FilterMode Then
                        li.AutoFilter.ShowAllData
                    End If

                    If li.DataBodyRange Is Nothing Then

                        'a data table without records

                        '==> insert 2 records
                        li.ListRows.Add AlwaysInsert:=True
                        li.ListRows.Add AlwaysInsert:=True

                    Else

                        'a data table with at least 1 record

                        '==> duplicate the selected row
                        Application.DisplayAlerts = False
                        'add a row and copy the contents
                        li.ListRows.Add(lRow - li.DataBodyRange.Row + 2).Range.FillDown
                        Rows(lRow + 1).RowHeight = Rows(lRow).RowHeight
                        rngStart.Offset(1).Select
                        Application.DisplayAlerts = True

                    End If

                Else

                    MsgBox "This Table has a SourceType = " & li.SourceType & ", which is not supported in this macro." & vbNewLine & vbNewLine & _
                           Replace(Replace("0_NO SUPPORT_External data source (Microsoft SharePoint Foundation site)_(xlSrcExternal)|" & _
                                           "1_SUPPORT__Range_(xlSrcRange)|2_NO SUPPORT_XML_(xlSrcXml)|3_NO SUPPORT_Query_(xlSrcQuery)|4_NO SUPPORT_PowerPivot Model_(xlSrcModel)", _
                                           "|", vbNewLine), "_", vbTab), vbInformation

                End If

            End If

            Application.ScreenUpdating = True

        End If

    End If

End Sub

Personal macro workbook

As said above, I use this macro a lot, that's why I added a shortcut key to launch it (Ctrl + e) and why I added the macro to my personal macro workboek. Use this macro if you find it useful !

• « Previous Excel article
• Next Excel article »