How to randomly distribute some available data in excel (a million entries) to a group of 10 columns/rows?

I have a column of "IDs" of employees (about 1million entries) and I want to distribute them randomly to new 10 rows/columns in a new excel sheet.

For instance:

Card ID
123

132

143

...


I want to randomly distribute this data to 10 new columns/rows (whatever is feasible) in a new excel sheet.

A1:A1000000

B1:K100000

randomly distribute it to those 10 columns

prepare an excel sheet with those 10 columns having the entries randomly

1 Answer
1

This procedure is one of several ways you could accomplish this:

Sub randomColumns()

Const inputSheet = "Sheet1" 'name of the sheet with the million values
Const inputColumn = 1 'column # where the million values are
Const inputStartRow = 1 'rows # of the first value
Const outputColumns = 10 'number of columns randomize into

Dim wsIn As Worksheet, wsOut As Worksheet
Dim rw As Long, inValue As Variant, outCol As Long
Set wsIn = Sheets(inputSheet) 'setup worksheets
Set wsOut = ActiveWorkbook.Worksheets.Add 'create new worksheet
rw = inputStartRow
Randomize 'seed random number generator

With wsOut
Do
inValue = wsIn.Cells(rw, inputColumn) 'get the value to move
outCol = Int(Rnd() * outputColumns) + 1 'pick random column
.Cells(Application.WorksheetFunction. _
CountA(.Columns(outCol)) + 1, outCol) = inValue 'move value
wsIn.Cells(rw, inputColumn) = "" 'remove value from old location
rw = rw + 1 'next input row
Loop While wsIn.Cells(rw, inputColumn) <> "" 'loop until blank cell
End With
MsgBox "Randomized " & rw - 1 & " items to worksheet '" & wsOut.Name & "'."

End Sub


Change the value of constant inputSheet to the name of the worksheet with the values. If necessary change the other constants, otherwise it will start looking for values in A1 of inputSheet.

inputSheet

A1

inputSheet

A new worksheet will be created and then each number will be placed at the bottom of the values in a randomly selected column, and then deleted from inputSheet.

inputSheet

This will continue until a blank cell is encountered on inputSheet.

inputSheet

By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.