Randomize a set of values without repeating value index - excel

Question

I have a requirement to randomize or shuffle a cet of cells in column A subject to the constraint that no cell remains unchanged.
I am placing the candidate randomization in column C with this code:
Sub ShuffleCutandDeal()
Dim A As Range, C As Range
Dim B As Range, cell As Range
Set A = Range("A1:A24")
Set B = Range("B1:B24")
Set C = Range("C1")
A.Copy C
Randomize
For Each cell In B
cell.Value = Rnd()
Next cell
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("B1:B24") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("B1:C24")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
The randomization works, but sometimes I get something like:
When I see that a data item has not moved, I re-run the code until all items have been moved.
It seems to me that this "If at first you don't succeed........." approach is really dumb.
Is there a better way to randomize and insure that all the items have moved in one pass ???
EDIT#1:
Based on iliketocode's comment, I attempted to adapt Tony's approach in this post to VBA:
Sub Tony()
Dim A As Range, C As Range
Dim m As Long, t As Variant, i As Long
Dim wf As WorksheetFunction
Set wf = Application.WorksheetFunction
Set A = Range("A1:A24")
Set C = Range("C1:C24")
A.Copy C
For m = 1 To 22
i = wf.RandBetween(m + 1, 24)
t = C(i)
C(i) = C(m)
C(m) = t
Next m
t = C(23)
C(23) = C(24)
C(24) = t
End Sub
I guess the idea is to:Swap C1 with a random pick between C2 and C24 then
Swap C2 with a random pick between C3 and C24 thenSwap C3 with a random pick between C4 and C24 then................Swap C22 with a random pick between C23 and C24 and finallySwap C23 and C24.
I ran this 1000 times with no unwanted matches appearing.

Answer 1

I had to write my own version of the worksheet's native RANK function in order to compare to the ordinal placement of the randomized value but I think this may be getting close.
Option Explicit
Sub shuffleCutDeal()
Dim i As Long, j As Long, tmp As Variant, vVALs As Variant
With Worksheets("Sheet1")
.Columns("B:D").ClearContents
'get the values from the worksheet
vVALs = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Value2
'add an extra 'column' for random index position ('helper' rank)
ReDim Preserve vVALs(LBound(vVALs, 1) To UBound(vVALs, 1), _
LBound(vVALs, 2) To UBound(vVALs, 2) + 1)
'populate the random index positions
Randomize
For i = LBound(vVALs, 1) To UBound(vVALs, 1)
vVALs(i, 2) = Rnd
Next i
'check for duplicate index postions and re-randomize
Do
Randomize
For i = LBound(vVALs, 1) To UBound(vVALs, 1)
If arrRank(vVALs(i, 2), Application.Index(vVALs, 0, 2)) = i Then
vVALs(i, 2) = Rnd
Exit For
End If
Next i
Loop Until i > UBound(vVALs, 1)
'sort the variant array
For i = LBound(vVALs, 1) + 1 To UBound(vVALs, 1)
For j = LBound(vVALs, 1) To UBound(vVALs, 1) - 1
If vVALs(i, 2) > vVALs(j, 2) Then
tmp = Array(vVALs(i, 1), vVALs(i, 2))
vVALs(i, 1) = vVALs(j, 1)
vVALs(i, 2) = vVALs(j, 2)
vVALs(j, 1) = tmp(0)
vVALs(j, 2) = tmp(1)
End If
Next j
Next i
'[optional] get rid of the 'helper' rank
'ReDim Preserve vVALs(LBound(vVALs, 1) To UBound(vVALs, 1), _
LBound(vVALs, 2) To UBound(vVALs, 2) - 1)
'return the values to the worksheet
.Cells(1, 3).Resize(UBound(vVALs, 1), UBound(vVALs, 2)) = vVALs
End With
End Sub
Function arrRank(val As Variant, vals As Variant, _
Optional ordr As Long = xlDescending)
Dim e As Long, n As Long
If ordr = xlAscending Then
For e = LBound(vals, 1) To UBound(vals, 1)
n = n - CBool(vals(e, 1) <= val)
Next e
Else
For e = LBound(vals, 1) To UBound(vals, 1)
n = n - CBool(vals(e, 1) >= val)
Next e
End If
arrRank = n
End Function
I ran it repeatedly against the original values with a CF rule that highlighted duplicates and never found one.

Answer 2

A permutation which moves everything is called a derangement. A classic result in probability is that the probability of a randomly chosen permutation being a derangement is approximately 1/e (where e = 2.71828... is the natural base). This is roughly 37%. Thus -- generating random permutations until you get a derangement is almost certain to work fairly rapidly. Doing anything otherwise risks introducing subtle biases in the distribution of the derangments generated. Of course, you should have the code itself loop until it succeeds rather than rerunning it yourself.