randomise rows in VBA - vba

Question

so i have an excel file with multiple columns and rows. At the moment it looks like this:
| A | B | C | D
---------------------
1 | 1a | 1b | 1c | 1d
---------------------
2 | 2a | 2b | 2c | 2d
---------------------
3 | 3a | 3b | 3c | 3d
----------------------
How can i randomise it with VBA so that it becomes:
| A | B | C | D
---------------------
1 | 3a | 3b | 3c | 3d
---------------------
2 | 1a | 1b | 1c | 1d
---------------------
3 | 2a | 2b | 2c | 2d
----------------------

Answer 1

It's true that this question has many possible answers. This is probably the most lame one, but it works quite ok actually:
Add an additional column;
Then put random value in this column;
Sort by this column - that's exactly what you want!
Delete the additional column, so the trick is no visible!
Voila!
Just to give you some idea how this should look like:
Option Explicit
Public Sub Randomize()
Dim lCounter As Long
Application.ScreenUpdating = False
Columns("A:A").Insert Shift:=xlToRight
For lCounter = 1 To 5
Cells(lCounter, 1) = Rnd()
Next lCounter
With ActiveSheet.Sort
.SortFields.Add Key:=Range("A1:A5")
.SetRange Range("A1:E5")
.Apply
End With
Columns("A:A").Delete
Application.ScreenUpdating = False
End Sub
It would work on data like this one:
You can further update the code, by removing the magic numbers and improving the ranges.

Answer 2

I'd go like follows:
Sub ShuffleRows()
Dim vals As Variant, val As Variant
Dim iRow As Long
With Range("A1").CurrentRegion '<--| reference your contiguous range
vals = .Value '<--| store its content in an array
For Each val In GetRandomNumbers(.Rows.count) '<--| loop through referenced range shuffled rows indexes
iRow = iRow + 1 '<--| update current row to write in counter
.Rows(iRow).Value = Application.Index(vals, val, 0) '<--| write in current rows to write the random row from corresponding shuffled rows indexes
Next
End With
End Sub
Function GetRandomNumbers(ByVal n As Long) As Variant
Dim i As Long, rndN As Long, tempN As Long
ReDim randomNumbers(1 To n) As Long '<--| resize the array to the number of rows
For i = 1 To n '<--| fill it with integer numbers from 1 to nr of rows
randomNumbers(i) = i
Next
'shuffle array
Do While i > 2
i = i - 1
Randomize
rndN = Int(i * Rnd + 1)
tempN = randomNumbers(i)
randomNumbers(i) = randomNumbers(rndN)
randomNumbers(rndN) = tempN
Loop
GetRandomNumbers = randomNumbers
End Function

Answer 3

This is my solution:
First I have created a function to generate random numbers between a and b without repeated values:
jlqmoreno#gmail.com
Julio Jesus Luna Moreno
Option Base 1
Public Function u(a As Variant, b As Variant) As Variant
Application.Volatile
Dim k%, p As Double, flag As Boolean, x() As Variant
k = 1
flag = False
ReDim x(1)
x(1) = Application.RandBetween(a, b)
Do Until k = b - a + 1
Do While flag = False
Randomize
p = Application.RandBetween(a, b)
'Debug.Assert p = 2
resultado = Application.Match(p, x, False)
If IsError(resultado) Then
k = k + 1
ReDim Preserve x(k)
x(k) = p
flag = True
Else
flag = False
End If
Loop
flag = False
Loop
u = x
End Function
this is nessesary since i needed a funtion to create random indices with no duplicates (This was the rough part)
Then i used this function using the logic i applied here
with this function:
Public Function RNDORDER(rango As Range) As Variant
Dim z() As Variant, n%, m%, i%, j%, y() As Variant, k%
n = rango.Rows.count
m = rango.Columns.count
k = 1
ReDim x(n, m)
ReDim y(n)
y = u(1, n)
For i = 1 To n
For j = 1 To m
x(i, j) = rango(y(i), j)
Next j
Next i
RNDORDER = x
Just run this function as an array function.
Thanks!