randomise rows in 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
----------------------

Read your values row wise in an array and than apply the logic from [**`this`**](http://stackoverflow.com/a/19117923/1652222) answer. — ManishChristian, Feb 24 '17 at 14:30
@ManishChristian Check my answer , feedback will be well received. — Moreno, Feb 25 '17 at 04:32

score 2 · Accepted Answer · answered Feb 24 '17 at 18:37

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.

score 0 · Answer 2 · edited May 23 '17 at 10:31

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!

score 0 · Answer 3 · answered Feb 25 '17 at 17:44

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

randomise rows in VBA

3 Answers3

Linked