Consulting

Results 1 to 3 of 3

Thread: VBA - Copy & insert the currently selected row of data multiple times

  1. #1
    VBAX Visitor
    Joined
    Jun 2024
    Posts
    1
    Location

    VBA - Copy & insert the currently selected row of data multiple times

    Hello new to VBA here and spent a great deal trying to search and figure this out myself but cannot.


    I want to create a macro in excel that copies the currently active cells row and inserts it a number of times below by the currently selected cell and then changes whatever the number was to a 1. I have attached a before and after example below of what I am after.

    Before Macro.jpg After Macro.jpg

    I managed to find a code on this site which I changed slightly which can do the first part of my problem but not the second part of changing the specified number to a 1.

    Sub DuplicateRow()
        Dim NextRow As Long
        Dim NrOfCopies As Long
        Dim i As Long
    ' Dont think I need this? '
        Const NrOfCopiesDefault = 1
        Const NrOfCopiesMaximum = 1000
         
        Do
    ' I believe this selects the cell to start at and the number of copies to make '
            On Error Resume Next
            NrOfCopies = ActiveCell - 1
            On Error GoTo 0
    ' Dont think I need this'
            If NrOfCopies = 0 Then
                MsgBox "No copies made.", vbInformation, "CANCELLED"
                Exit Sub
            End If
             
        Loop While NrOfCopies < 1 Or NrOfCopies > NrOfCopiesMaximum
    ' I assume this is the code to insert new rows and copy said row down a number of times '
        With Selection
            NextRow = .Row + .Rows.Count
            Rows(NextRow & ":" & NextRow + .Rows.Count * (NrOfCopies) - 1).Insert Shift:=xlDown
            .EntireRow.Copy Rows(NextRow & ":" & NextRow + .Rows.Count * (NrOfCopies) - 1)
            .Resize(.Rows.Count * (NrOfCopies + 1)).Sort key1:=.Cells(1, 1)
        End With
    ' I want to put in code to change the number in each copied row to a 1 here? '
    End Sub
    I'd me more than ok to edit the code above or start fresh. Also would love to add descriptive titles like in my code so I can understand what the code means for future reference as I love to learn new things. Thank you for your help.

  2. #2
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,244
    Location
    Hi Scawtt,

    Welcome to the forum.

    Out of interest, which version of Excel do you use: 2016, 2021, 365?

    If you are using Excel 365 for example then the below will do it:
    Sub Test()
      Dim r As Long, str As String, rpt As Long, s As Variant
      
      r = ActiveCell.Row
      str = Cells(r, 1)
      rpt = Cells(r, 2)
      
      Rows(r + 1 & ":" & r + (rpt - 1)).Insert
      With Application
        s = .Sequence(rpt, , 1, 0)
        Cells(r, 1).Resize(rpt) = .Rept(str, s)
        Cells(r, 2).Resize(rpt) = s
      End With
    End Sub
    Attached Files Attached Files
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2405, Build 17628.20102

  3. #3
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,244
    Location
    Just noticed that you wanted annotations:
    Sub Test()
      Dim r As Long, str As String, rpt As Long, s As Variant
      
      r = ActiveCell.Row ' assign "r" to be the active row
      str = Cells(r, 1) ' '"str" becomes the value in column A (column One) of the active row
      rpt = Cells(r, 2) ' '"rpt" becomes the value in column B (column Two) of the active row
      
      ' inserts ("rpt" less one) rows under the active row ("r")
      ' So: (active row + 1) to (active row + (rpt - 1))
      ' This means that the count of active row and the newly inserted rows will be equal to "rpt" rows
      Rows(r + 1 & ":" & r + (rpt - 1)).Insert
      
      
      With Application ' saves me typing Application over and over, anything that starts with "." now refers to Application
        ' creates an array with "rpt" amount of rows, the sequence starts at 1 and the step to the sequence is 0, therefore we get an array with "rpt" amount of 1's
        s = .Sequence(rpt, , 1, 0)
        ' resizes the range: column one active row to be "rpt" amount of rows starting at the active row
        ' the .Rept part repeats the "str" once for every time there is a one in the sequence of 1's we created in the array "s"
        ' so the resized range now = the array of "str" we created
        Cells(r, 1).Resize(rpt) = .Rept(str, s)
        ' resizes the range: column two active row to be "rpt" amount of rows starting at the active row
        ' as "s" is now just an array of 1's with a count of "rpt" we can just make the resized range = "s"
        Cells(r, 2).Resize(rpt) = s
      End With
    End Sub

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •