Repeated cells in same column VBA

grifdoogindoggy

New Member
Joined
Aug 27, 2019
Messages
21
I am struggling to create a simple loop that will allow me to repeat a cell value down a column for a number of my choosing.

I want to turn this:
A1
A2
A3

Into this ("2", for example):
A1
A1
A2
A2
A3
A3

Anything helps! Thank you.
 

Some videos you may like

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

JackDanIce

Well-known Member
Joined
Feb 3, 2010
Messages
9,674
Office Version
365
Platform
Windows
Try:
Code:
Sub M1()

    Dim v   As Variant
    Dim x   As Long
    Dim i   As Long
    
    x = InputBox("Enter repetition value: ")
    v = Cells(1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row).Value
    
    Application.ScreenUpdating = False
    
    If x > 1 Then
        For i = 2 To x
            Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(v, 1)).Value = v
        Next i
        Cells(1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row).Sort key1:=Cells(1, 1), order1:=xlAscending
    End If
    
    Application.ScreenUpdating = True
    
End Sub
 
Last edited:

JackDanIce

Well-known Member
Joined
Feb 3, 2010
Messages
9,674
Office Version
365
Platform
Windows
You're welcome, glad it's resolved :)
 

grifdoogindoggy

New Member
Joined
Aug 27, 2019
Messages
21
Try:
Code:
Sub M1()

    Dim v   As Variant
    Dim x   As Long
    Dim i   As Long
    
    x = InputBox("Enter repetition value: ")
    v = Cells(1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row).Value
    
    Application.ScreenUpdating = False
    
    If x > 1 Then
        For i = 2 To x
            Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(v, 1)).Value = v
        Next i
        Cells(1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row).Sort key1:=Cells(1, 1), order1:=xlAscending
    End If
    
    Application.ScreenUpdating = True
    
End Sub
How would I print this to a new sheet?
 

JackDanIce

Well-known Member
Joined
Feb 3, 2010
Messages
9,674
Office Version
365
Platform
Windows
Change parts in red to suit:
Rich (BB code):
Sub M1()

    Dim v   As Variant
    Dim x   As Long
    Dim i   As Long
    
    Dim srcSheet    As Worksheet
    Dim destSheet   As Worksheet
    
    Set srcSheet = Sheets("Source")
    Set destSheet = Sheets("Destination")
    
    x = InputBox("Enter repetition value: ")
    v = srcSheet.Cells(1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row).Value
    
    Application.ScreenUpdating = False
    
    If x > 1 Then
        With destSheet
            For i = 2 To x
                .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(v, 1)).Value = v
            Next i
            .Cells(1, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row).Sort key1:=Cells(1, 1), order1:=xlAscending
        End With
    End If
    
    Application.ScreenUpdating = True
    
    Set srcSheet = Nothing: Set destSheet = Nothing
    
End Sub
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,102,288
Messages
5,485,909
Members
407,523
Latest member
Talicius

This Week's Hot Topics

Top