Consulting

Results 1 to 2 of 2

Thread: VBA assign random variables to cells

  1. #1
    VBAX Newbie
    Joined
    Feb 2016
    Posts
    1
    Location

    VBA assign random variables to cells

    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!

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,729
    Location
    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
    Attached Files Attached Files
    Last edited by Paul_Hossler; 02-28-2016 at 08:28 AM. Reason: Added .ClearContents to better handle re-runs
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •