Forum Discussion

Dantheman348's avatar
Dantheman348
Copper Contributor
Jan 01, 2025

Special sort required

I have a column of 8 numbers. I want to scramble these numbers so no 2 numbers repeat themselves, through 4 columns. The 4 columns represent 4 games to be played. The two numbers together repersent horseshoe teams. I would like excel through VBA to do this automatically. There will be as many as 16 teams to scramble. Included is a picture of what I am trying to accomplish. Any help would be great. I could not put these teams in a column but I think you understand what I am trying to have Excel do. I tried taking a picture on my spreadsheet but the file was to big. Thanks for your help

12345678
27145368
71465283
24573618

excel
Macros and VBA

1 Reply

Sort By
  • NikolinoDE's avatar
    NikolinoDE
    Gold Contributor
    Jan 04, 2025

    Attached is an attempt with VBA. Backup your file first before you using the Code. The code is untested.

    Sub ScrambleTeams()
    Dim Teams As Variant
    Dim i As Integer, j As Integer
    Dim Games(1 To 4, 1 To 8) As Integer ' 4 Games, 8 Numbers
    Dim UsedNumbers As Object
    Dim RowOffset As Integer
    Dim RandomIndex As Integer
    Dim Temp As Integer

    ' Define the team numbers (adjust as needed)
    Teams = Array(1, 2, 3, 4, 5, 6, 7, 8) ' Adjust for 16 if needed

    ' Shuffle the teams randomly
    For i = UBound(Teams) To 1 Step -1
        RandomIndex = Int((i + 1) * Rnd)
        Temp = Teams(i)
        Teams(i) = Teams(RandomIndex)
        Teams(RandomIndex) = Temp
    Next i

    ' Create unique pairings for 4 rounds (rows)
    Set UsedNumbers = CreateObject("Scripting.Dictionary")

    For i = 1 To 4 ' 4 games
        UsedNumbers.RemoveAll ' Clear previous round's numbers
        RowOffset = (i - 1) * 2 ' Shift by 2 rows for each game

        j = 0
        Do While j < 8
            RandomIndex = Int((UBound(Teams) + 1) * Rnd) ' Get a random index

            If Not UsedNumbers.exists(Teams(RandomIndex)) Then
                Games(i, j + 1) = Teams(RandomIndex)
                UsedNumbers.Add Teams(RandomIndex), True
                j = j + 1
            End If
        Loop
    Next i

    ' Output results to Sheet1 (adjust as needed)
    With Sheets("Sheet1")
        .Range("A1:H4").ClearContents ' Clear old data
        For i = 1 To 4
            For j = 1 To 8
                .Cells(i, j).Value = Games(i, j)
            Next j
        Next i
    End With

    MsgBox "Teams Scrambled Successfully!", vbInformation
End Sub

    My answers are voluntary and without guarantee!

    Hope this will help you.

    Happy Excel-ing!

Resources