Adding rows containing values based on input cell

Charlie987

New Member
Joined
Jul 25, 2020
Messages
25
Office Version
  1. 365
Platform
  1. Windows
Hi,
I am quite new to excel developer.
I am l trying to create an excel workbook where-- one tab contains values eg.
| Peter | 2 |
| John | 3 |
| Mark | 1 |

where the value '2' indicates that Peter will have 2 rows inserted containing 'Peter' (the value in the column before it) on another tab of the workbook (or even in another workbook if that were possible).
eg.
Peter
Peter
John
John
John
Mark
I am not really sure where to start with this so any advice would be appreciated.
Thank you!
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Try this

Select the sheet containing the list and run the macro
Assumes data starts in cell A2
New workbook created containing required values

VBA Code:
Sub CreateSheet()
    Dim rng As Range, cel As Range, cel2 As Range, r As Long
    With ActiveSheet
        Set rng = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
    End With
    With Workbooks.Add
        Set cel2 = .Sheets(1).Cells(.Sheets(1).Rows.Count, 1)
    End With
    For Each cel In rng
        For r = 1 To cel.Offset(, 1)
            cel2.End(xlUp).Offset(1) = cel
        Next r
    Next cel
End Sub
 
Upvote 0
Same initial instructions/assumptions as Yongle but if your final list is large, this could be faster. Even if not, it is an alternative to consider. :)

VBA Code:
Sub Duplicate_Rows()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long

  a = Range("A2", Range("B" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To Application.Sum(Application.Index(a, 0, 2)) + 1, 1 To 1)
  b(1, 1) = "Name"
  k = 1
  For i = 1 To UBound(a)
    For j = 1 To a(i, 2)
      k = k + 1
      b(k, 1) = a(i, 1)
    Next j
  Next i
  Workbooks.Add.Sheets(1).Range("A1").Resize(UBound(b)).Value = b
End Sub
 
Upvote 0
They are both perfect! thank you so much. One more question -- how would I go about making column b on the new worksheet print the count eg.
Peter 1
Peter 2
John 1
John 2
John 3
etc.
Thanks again! This has helped immensely!
 
Upvote 0
Minor amendment to one line
Rich (BB code):
Sub CreateSheet()
    Dim rng As Range, cel As Range, cel2 As Range, r As Long
    With ActiveSheet
        Set rng = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
    End With
    With Workbooks.Add
        Set cel2 = .Sheets(1).Cells(.Sheets(1).Rows.Count, 1)
    End With
    For Each cel In rng
        For r = 1 To cel.Offset(, 1)
            cel2.End(xlUp).Offset(1).Resize(, 2).Value = Array(cel, r)
        Next r
    Next cel
End Sub
 
Upvote 0
For my code:
VBA Code:
Sub Duplicate_Rows_v2()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long

  a = Range("A2", Range("B" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To Application.Sum(Application.Index(a, 0, 2)) + 1, 1 To 2)
  b(1, 1) = "Name": b(1, 2) = "Count"
  k = 1
  For i = 1 To UBound(a)
    For j = 1 To a(i, 2)
      k = k + 1
      b(k, 1) = a(i, 1): b(k, 2) = j
    Next j
  Next i
  Workbooks.Add.Sheets(1).Range("A1:B1").Resize(UBound(b)).Value = b
End Sub
 
Upvote 0
Hi,
Wondering if anyone could help with how I would another column to either of the codes above between the name and the count that represents the surname (same duplication based on the count)
eg.
Peter Smith 1
Peter Smith 2
John Adams 1
John Adams 2
John Adams 3
Thanks again everyone!
 
Upvote 0
Wondering if anyone could help with how I would another column to either of the codes above between the name and the count that represents the surname (same duplication based on the count)
So from this
20 08 22.xlsm
ABC
1First nameSurnameCount
2PeterSmith2
3JohnAdams3
Repeats


To this?
Book2
ABC
1NameSurnameCount
2PeterSmith1
3PeterSmith2
4JohnAdams1
5JohnAdams2
6JohnAdams3
Sheet1


VBA Code:
Sub Duplicate_Rows_v3()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long

  a = Range("A2", Range("C" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To Application.Sum(Application.Index(a, 0, 3)) + 1, 1 To 3)
  b(1, 1) = "Name": b(1, 2) = "Surname": b(1, 3) = "Count"
  k = 1
  For i = 1 To UBound(a)
    For j = 1 To a(i, 3)
      k = k + 1
      b(k, 1) = a(i, 1): b(k, 2) = a(i, 2): b(k, 3) = j
    Next j
  Next i
  Workbooks.Add.Sheets(1).Range("A1").Resize(UBound(b), UBound(b, 2)).Value = b
End Sub
 
Upvote 0
Once again that is perfect! thank you so much! -- I thought I could figure it out myself but couldn't quite get it working. Thanks!
 
Upvote 0
Once again that is perfect! thank you so much!
No problem. :)


I thought I could figure it out myself but couldn't quite get it working.
There were quite a few things to change. Here is a general solution for any number of columns, so long as the number of repeats is in the last column. & that column heading is the last thing in row 1.

VBA Code:
Sub Duplicate_Rows_v4()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, x As Long, Cols As Long
  
  Cols = Cells(1, Columns.Count).End(xlToLeft).Column
  a = Range("A2", Cells(Rows.Count, Cols).End(xlUp)).Value
  ReDim b(1 To Application.Sum(Application.Index(a, 0, Cols)) + 1, 1 To Cols)
  For i = 1 To Cols
    b(1, i) = Cells(1, i).Value
  Next i
  k = 1
  For i = 1 To UBound(a)
    For j = 1 To a(i, Cols)
      k = k + 1
      For x = 1 To Cols - 1
        b(k, x) = a(i, x)
      Next x
      b(k, Cols) = j
    Next j
  Next i
  Workbooks.Add.Sheets(1).Range("A1").Resize(UBound(b), UBound(b, 2)).Value = b
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,237
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top