kalo7932
02-27-2016, 09:45 PM
Hi, I'm trying to create a macro where the user is prompted to enter team names for a softball league and then it randomly assigns the names to cells in the spreadsheet (that way they can create random teams each week). My code is set up right now so that all of the team names that have been entered are string variables. Is there a way to do this with VBA? 
Thanks!
Paul_Hossler
02-28-2016, 08:17 AM
I'd do something simple along these lines, assuming I'm understanding
In the attachment, you can click the arrow, but I listed the teams in Col A
Option Explicit
Sub GeneratePairings()
    Dim rTeams As Range
    Dim aPair() As Variant
    Dim i As Long, j As Long, iOut As Long
    Dim sTeam As String, dOrder As Double
    
    Set rTeams = ActiveSheet.Cells(1, 1).CurrentRegion
    Set rTeams = rTeams.Cells(2, 1).Resize(rTeams.Rows.Count - 1, 1)
    
    
    ReDim aPair(1 To rTeams.Rows.Count, 1 To 2)
    
    For i = LBound(aPair, 1) To UBound(aPair, 1)
        aPair(i, 1) = rTeams.Cells(i).Value
        aPair(i, 2) = Rnd
    Next i
    
    
    'simple bubble sort
    For i = LBound(aPair, 1) To UBound(aPair, 1) - 1
        For j = i To UBound(aPair, 1)
            If aPair(i, 2) > aPair(j, 2) Then
                sTeam = aPair(i, 1)
                dOrder = aPair(i, 2)
                aPair(i, 1) = aPair(j, 1)
                aPair(i, 2) = aPair(j, 2)
                aPair(j, 1) = sTeam
                aPair(j, 2) = dOrder
            End If
        Next j
    Next i
    
    iOut = 2
    ActiveSheet.Cells(iOut, 7).Resize(ActiveSheet.Rows.Count - 1, 1).ClearContents
    For i = LBound(aPair, 1) To UBound(aPair, 1) - 1 Step 2
        ActiveSheet.Cells(iOut, 7).Value = aPair(i, 1) & " vs. " & aPair(i + 1, 1)
        iOut = iOut + 1
    Next i
    If UBound(aPair, 1) Mod 2 = 1 Then
        ActiveSheet.Cells(iOut, 7).Value = aPair(UBound(aPair, 1), 1) & " Bye"
    End If
 
End Sub
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.