none
Duplicate rows n times in VBA with running counter RRS feed

  • Question

  • I have a table that looks like below and wondering how to duplicate each record based on a cell value and put a running counter to it. Pretty new to VBA, any help is appreciated. :)

    What I Have -

    Process	Date	Repeat
    A	Friday	3
    B	Tuesday	4
    C	Monday	5

    What I want - 

    Process	Date	Repeat	Counter
    A	Friday	3	1
    A	Friday	3	2
    A	Friday	3	3
    B	Tuesday	4	1
    B	Tuesday	4	2
    B	Tuesday	4	3
    B	Tuesday	4	4
    C	Monday	5	1
    C	Monday	5	2
    C	Monday	5	3
    C	Monday	5	4
    C	Monday	5	5

    Thanks in Advance!

    Tuesday, March 28, 2017 4:37 AM

Answers

  • Here you go:

    Sub InsertRows()
        Dim r As Long
        Dim m As Long
        Dim i As Long
        Dim n As Long
        Application.ScreenUpdating = False
        Range("D1").Value = "Counter"
        m = Range("A" & Rows.Count).End(xlUp).Row
        For r = m To 2 Step -1
            n = Range("C" & r).Value
            For i = n To 2 Step -1
                Range("A" & r).EntireRow.Copy
                Range("A" & r + 1).Insert
                Range("D" & r + 1).Value = i
            Next i
            Range("D" & r).Value = 1
        Next r
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by SambitNandi Tuesday, March 28, 2017 6:18 AM
    Tuesday, March 28, 2017 6:07 AM

All replies

  • Here you go:

    Sub InsertRows()
        Dim r As Long
        Dim m As Long
        Dim i As Long
        Dim n As Long
        Application.ScreenUpdating = False
        Range("D1").Value = "Counter"
        m = Range("A" & Rows.Count).End(xlUp).Row
        For r = m To 2 Step -1
            n = Range("C" & r).Value
            For i = n To 2 Step -1
                Range("A" & r).EntireRow.Copy
                Range("A" & r + 1).Insert
                Range("D" & r + 1).Value = i
            Next i
            Range("D" & r).Value = 1
        Next r
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by SambitNandi Tuesday, March 28, 2017 6:18 AM
    Tuesday, March 28, 2017 6:07 AM
  • Thanks a lot. You are a lifesaver!!!
    Tuesday, March 28, 2017 6:16 AM