Replicate names based on count

[FryGirl]

I have a table of names with their count in column B.

How can I get the modified results in column C whether formula or VBA?

bibles.xlsm
	A	B	C
1	Book	Count	Revised
2	John	7	John
3	Paul	4	John
4	Adam	6	John
5	Susan	5	John
6			John
7			John
8			John
9			Paul
10			Paul
11			Paul
12			Paul
13			Adam
14			Adam
15			Adam
16			Adam
17			Adam
18			Adam
19			Susan
20			Susan
21			Susan
22			Susan
23			Susan
Sheet1

 

[mrshl9898]

Try:

Sub addnames()

Dim rownum As Long
Dim rownum2 As Long
Dim counter As Long

rownum = 2
rownum2 = 2

Do Until Cells(rownum, 1) = ""
counter = 1
    Do Until counter = Cells(rownum, 2) + 1
    Cells(rownum2, 3) = Cells(rownum, 1)
    counter = counter + 1
    rownum2 = rownum2 + 1
    Loop
rownum = rownum + 1
Loop

End Sub

 

[sandy666]

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    Lists = Table.AddColumn(Source, "Custom", each {1..[Count]}),
    Expand = Table.ExpandListColumn(Lists, "Custom"),
    TSC = Table.SelectColumns(Expand,{"Book"}),
    Ren = Table.RenameColumns(TSC,{{"Book", "Revised"}})
in
    Ren

Book	Count		Revised
John	7		John
Paul	4		John
Adam	6		John
Susan	5		John
			John
			John
			John
			Paul
			Paul
			Paul
			Paul
			Adam
			Adam
			Adam
			Adam
			Adam
			Adam
			Susan
			Susan
			Susan
			Susan
			Susan

 

[VBasic2008]

• Copy the code into a standard module.
• Adjust the constants to fit your needs.

Option Explicit

Sub writeInstances()
    
    Const FirstRow As Long = 2
    Const srcValue As Variant = "A"
    Const srcCount As Variant = "B"
    Const tgtValue As Variant = "C"
    
    ' Define Value Processing Range.
    Dim rng As Range
    Set rng = Range(Cells(FirstRow, srcValue), _
                    Cells(Rows.Count, srcValue))
    ' Define Value Last Cell Range.
    Dim cel As Range
    Set cel = rng.Find(What:="*", _
                       LookIn:=xlFormulas, _
                       SearchDirection:=xlPrevious)
    ' Validate Value Last Cell Range.
    If cel Is Nothing Then
        GoTo ProcExit
    End If
    ' Define Value Column Range.
    Set rng = Range(rng.Cells(1), cel)
    
    ' Write values from Value and Count Column Ranges to arrays of Source Array.
    Dim OneCell As Variant
    ReDim OneCell(1 To 1, 1 To 1)
    Dim Source As Variant
    ReDim Source(1 To 2)
    If rng.Rows.Count > 1 Then
        Source(1) = rng.Value
        Source(2) = rng.Offset(, Columns(srcCount).Column _
                               - Columns(srcValue).Column).Value
    Else
        Source(1) = OneCell
        Source(1)(1, 1) = rng.Value
        Source(2)(1, 1) = rng.Offset(, Columns(srcCount).Column _
                                     - Columns(srcValue).Column).Value
    End If
        
    ' Write values from Source Array to Target Array.
    Dim Target As Variant
    Dim CurrentValue As Variant
    Dim CountValue As Variant
    ReDim Target(1 To WorksheetFunction.Sum(Source(2)), 1 To 1)
    Dim i As Long
    Dim j As Long
    Dim k As Long
    For i = 1 To UBound(Source(1))
        CountValue = Source(2)(i, 1)
        If VarType(CountValue) = vbDouble Then
            CountValue = CLng(CountValue)
            If CountValue > 0 Then
                CurrentValue = Source(1)(i, 1)
                For j = 1 To CountValue
                    k = k + 1
                    Target(k, 1) = CurrentValue
                Next j
            End If
        End If
    Next i
    If k = 0 Then
        GoTo ProcExit
    End If
    
    ' Copy values from Target Array to Target Column Range.
    Set cel = rng.Cells(1).Offset(, Columns(tgtValue).Column _
                                  - Columns(srcValue).Column)
    cel.Resize(Rows.Count - cel.Row + 1).Clear
    cel.Resize(k).Value = Target
    
ProcExit:
End Sub

 

[FryGirl]

Thank you all. @sandy, I can't figure out how you make the custom column for the second step Lists? Is there some extra information you can provide here or a website to view?

 

[sandy666]

how you make the custom column for the second step Lists?

1. add Custom Column
2. type there: {1..[Count]}
3. ok

 

[FryGirl]

Thanks!

 

[sandy666]

Welcome!

 

[sandy666]

I prefer Like AND (not OR) solution mark

 

[sandy666]

Thanks!