Fisher Yates Shufflein Excel with VBA

[m4ltus]

Hello,

I need some help with my Excel project... My goal is to shuffle for example F26 to F45 with the fisher yates algorithm and put them shuffled in the cells blow (F49 to F68). I found this codes but I don't know how to implement this into my sheet.
Could you please help me with this? :) Thank you for your answers!

'Fisher–Yates shuffle
Sub ShuffleArray(Data&())
Dim i&, j&, iMin&, iMax&, Swap

iMin = LBound(Data): iMax = UBound(Data)
For i = iMax To iMin + 1 Step -1
j = Int((i - iMin + 1) * Rnd + iMin)
Swap = Data(i)
Data(i) = Data(j)
Data(j) = Swap
Next i
End Sub


Option Compare Database
Option Explicit

Private m_lNextRandomId&(), m_lIndex&

Private Sub Form_BeforeUpdate(Cancel As Integer)
Dim i&, valid As Boolean

On Error GoTo NoMoreFreeNumbers

Do
i = m_lNextRandomId(m_lIndex): m_lIndex = m_lIndex + 1
With Me.RecordsetClone
Call .FindFirst(BuildCriteria("rnd_id", dbLong, i))
If .NoMatch Then valid = True
End With
Loop Until valid
Me.rnd_id = i
Exit Sub

NoMoreFreeNumbers:
Cancel = True: Me.Undo
MsgBox "Kann keinen neuen Datensatz anlegen", vbInformation, _
"Keine freie Nummer vorhanden "
End Sub

Private Sub Form_Load()
Dim i&
ReDim m_lNextRandomId(100000 To 999999)
'ReDim m_lNextRandomId(100000 To 100010) 'zum Testen

For i = LBound(m_lNextRandomId) To UBound(m_lNextRandomId)
m_lNextRandomId(i) = i
Next i
Randomize: Call ShuffleArray(m_lNextRandomId)
m_lIndex = LBound(m_lNextRandomId)
End Sub

[Paul_Hossler]

Welcome to the forum

Please take a minute to read the FAQs and tips referenced in my signature

I think you wanted some thing like this

I changed the definition of ShuffleArray to take just a variant



Option Explicit

Sub ErstesMakro()
Dim rData As Range
Dim iCol As Long
Dim aryIn As Variant, aryOut As Variant

With Worksheets("Tabelle1")
Set rData = Range(.Range("B26"), .Range("B26").End(xlDown).End(xlToRight))
For iCol = 1 To rData.Columns.Count
aryIn = Application.WorksheetFunction.Transpose(rData.Columns(iCol))
aryOut = ShuffleArray(aryIn)
.Cells(49, iCol + 1).Resize(UBound(aryOut), 1).Value = Application.WorksheetFunction.Transpose(aryOut)
Next iCol

Range(.Range("B48"), .Range("B48").End(xlDown).End(xlToRight)).NumberFormat = .Range("B26").NumberFormat

End With
End Sub

[m4ltus]

Thank you so much! That works very well.
Does this work like the fisher yates algorithm?
:)

[Paul_Hossler]

Thank you so much! That works very well.
Does this work like the fisher yates algorithm?
:)

You're welcome

No idea even what that algorithm is

I just used the macro in the XLSM and shuffled that top part into the bottom part

If you have more details it might be possible