Adding rows containing values based on input cell

Charlie987

New Member
Joined
Jul 25, 2020
Messages
22
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!
 

Some videos you may like

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
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
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows
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
 

Charlie987

New Member
Joined
Jul 25, 2020
Messages
22
Office Version
  1. 365
Platform
  1. Windows
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!
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows
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
 

Charlie987

New Member
Joined
Jul 25, 2020
Messages
22
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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!
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows
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
 

Charlie987

New Member
Joined
Jul 25, 2020
Messages
22
Office Version
  1. 365
Platform
  1. Windows
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!
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,122,569
Messages
5,596,915
Members
414,110
Latest member
docops

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
Top