Splitting the data into 3 parts randomly - Excel - excel

Question

I have a dataset in an Excel sheet and i need to RANDOMLY split this (for instance 999 records) into 3 equal (and no duplicates) Excel files. Can this be done simply by using some Excel function or I need to write code to specifically do this?

Answer 1

Sometimes low-tech is best. If you don't need to repeat this very frequently...
add a column to the dataset, fill with =RAND()
sort the dataset on this column
copy the first 333 rows into a new sheet
copy the next 333 rows into a new sheet
I bet that would take less time than you've already spent trying to get the macros to work.

Answer 2

This revised macro will take the original 999 records and randomly distribute them into three other files (each file containing exactly 333 items) :
Sub croupier()
Dim k1 As Long, k2 As Long, k3 As Long
Dim Original As Workbook
Dim I As Long, ary(1 To 999)
Set Original = ActiveWorkbook
Dim rw As Long
Workbooks.Add
Set Winken = ActiveWorkbook
Workbooks.Add
Set Blinken = ActiveWorkbook
Workbooks.Add
Set Nod = ActiveWorkbook
k1 = 1
k2 = 1
k3 = 1
For I = 1 To 999
ary(I) = I
Next I
Call Shuffle(ary)
With Original.Sheets("Sheet1")
For I = 1 To 333
rw = ary(I)
.Cells(rw, 1).EntireRow.Copy Winken.Sheets("Sheet1").Cells(k1, 1)
k1 = k1 + 1
Next I
For I = 334 To 666
rw = ary(I)
.Cells(rw, 1).EntireRow.Copy Blinken.Sheets("Sheet1").Cells(k2, 1)
k2 = k2 + 1
Next I
For I = 667 To 999
rw = ary(I)
.Cells(rw, 1).EntireRow.Copy Nod.Sheets("Sheet1").Cells(k3, 1)
k3 = k3 + 1
Next I
End With
Winken.Save
Blinken.Save
Nod.Save
Winken.Close
Blinken.Close
Nod.Close
End Sub
Sub Shuffle(InOut() As Variant)
Dim HowMany As Long, I As Long, J As Long
Dim tempF As Double, temp As Variant
Hi = UBound(InOut)
Low = LBound(InOut)
ReDim Helper(Low To Hi) As Double
Randomize
For I = Low To Hi
Helper(I) = Rnd
Next I
J = (Hi - Low + 1) \ 2
Do While J > 0
For I = Low To Hi - J
If Helper(I) > Helper(I + J) Then
tempF = Helper(I)
Helper(I) = Helper(I + J)
Helper(I + J) = tempF
temp = InOut(I)
InOut(I) = InOut(I + J)
InOut(I + J) = temp
End If
Next I
For I = Hi - J To Low Step -1
If Helper(I) > Helper(I + J) Then
tempF = Helper(I)
Helper(I) = Helper(I + J)
Helper(I + J) = tempF
temp = InOut(I)
InOut(I) = InOut(I + J)
InOut(I + J) = temp
End If
Next I
J = J \ 2
Loop
End Sub

Answer 3

Here is a macro that will accept an array and copy to three different sheets:
Sub DoWork(Students As Variant)
Dim i As Long
Dim row As Integer
Dim sheetNumber As Integer
ReDim myArray(UBound(Students)) As Variant
Dim shuffledArray As Variant
Dim wkSheet As Worksheet
Dim myBooks(3) As Workbook
Set myBooks(1) = workBooks.Add
Set myBooks(2) = workBooks.Add
Set myBooks(3) = workBooks.Add
'populate the array with the number of rows
For i = 1 To UBound(Students)
myArray(i) = i
Next
'shuffle the array to provide true randomness
shuffledArray = ShuffleArray(myArray)
sheetNumber = 1
row = 1
'loop through the rows assiging to sheets
For i = 1 To UBound(Students)
If sheetNumber = 4 Then
sheetNumber = 1
row = row + 1
End If
Set wkSheet = myBooks(sheetNumber).ActiveSheet
wkSheet.Cells(row, 1) = Students(shuffledArray(i))
sheetNumber = sheetNumber + 1
Next
myBooks(1).SaveAs ("ws1.xlsx")
myBooks(2).SaveAs ("ws2.xlsx")
myBooks(3).SaveAs ("ws3.xlsx")
End Sub
Function ShuffleArray(InArray() As Variant) As Variant()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ShuffleArray
' This function returns the values of InArray in random order. The original
' InArray is not modified.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim N As Long
Dim Temp As Variant
Dim J As Long
Dim Arr() As Variant
Dim L As Long
Randomize
L = UBound(InArray) - LBound(InArray) + 1
ReDim Arr(LBound(InArray) To UBound(InArray))
For N = LBound(InArray) To UBound(InArray)
Arr(N) = InArray(N)
Next N
For N = LBound(Arr) To UBound(Arr)
J = CLng(((UBound(Arr) - N) * Rnd) + N)
Temp = Arr(N)
Arr(N) = Arr(J)
Arr(J) = Temp
Next N
ShuffleArray = Arr
End Function
Sub ShuffleArrayInPlace(InArray() As Variant)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ShuffleArrayInPlace
' This shuffles InArray to random order, randomized in place.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim N As Long
Dim L As Long
Dim Temp As Variant
Dim J As Long
Randomize
L = UBound(InArray) - LBound(InArray) + 1
For N = LBound(InArray) To UBound(InArray)
J = CLng(((UBound(InArray) - N) * Rnd) + N)
If N <> J Then
Temp = InArray(N)
InArray(N) = InArray(J)
InArray(J) = Temp
End If
Next N
End Sub
You would then call with something like this:
Option Explicit
Option Base 1
Sub Test()
Dim i As Long
Dim Students(999) As Variant
'populate the array with the number of rows
For i = 1 To UBound(Students)
Students(i) = "Students-" & Str(i)
Next
DoWork (Students)
End Sub