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