Fisher Yates Shufflein Excel with VBA

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!

Code:

---

          '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

---

Code:

---

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

---

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

Code:

---

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

---

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

Quote:

---

Originally Posted by m4ltus

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