Duplicate rows

[kuba9406]

Hi everybody,

This should be an easy for everyone that know <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-bottom-style: dotted; border-bottom-color: rgb(0, 0, 0); cursor: help; color: rgb(51, 51, 51); background-color: rgb(250, 250, 250);">VBA</acronym>

I want to duplicate all my rows and mix them (20000 of them)

Like that
Alan
John
Daniel
David
Alex
Jacob
....
TO


Alan
John
Alan
John
Daniel
David
Daniel
David
Alex
Jacob
Alex
Jacob
....

How can I do this? I will be so so thankful !

 

[s.ridd]

There's probably a more eloquent way of doing this but try the following code, replace "cells(1, 1)" with wherever your data starts. Also this will probably need altering if your data has headings or if your data isn't just one column. To do that you could use something like Range("A2:A" & Cells.SpecialCells(xlCellTypeLastCell).Row) where A is your column. if your data isn't one column then make sure you change the Offset to the appropriate number. Lastly note there is no real need for the c variable as I could have recycled the rngSort but for the sake of clarity I didn't. Anyway, perhaps you can build on this, it should run in under 5 seconds.

Sub randomsort()

Dim rng As Range
Dim c As Range
Dim rngSort As Range

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set rng = Cells(1, 1).CurrentRegion
    
    rng.Copy Cells(rng.Rows.Count + 1, rng.Column)
    
    Set rng = Cells(1, 1).CurrentRegion.Offset(, 1)
    
    For Each c In rng
        c.Value = Rnd()
    Next
    
    Set rngSort = Cells(1, 1).CurrentRegion
    
    rngSort.Sort Key1:=rng
    
    rng.ClearContents
    
    Set rngSort = Nothing
    Set rng = Nothing
    
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


End Sub

Hope this helps

Simon