Pic of current sheet layout

I've got a spreadsheet that I wrote for managing a league and am in the process of rewriting the entire thing for some practice.

I was wondering if anyone knew a way to shorten up the really repetitive loop I wrote.

People that check in have their names in column B. Once check in is completed, I fill an array with their names, randomize it, and place them on the cards shown on the right side.

My code for the loop is here, but just not sure if there is a more efficient way to do it.

Sub DivideIntoCards(playerArr As Variant)

Dim i, j As Integer
Dim remainder As Integer

With ActiveSheet
    
    remainder = UBound(playerArr) - LBound(playerArr)   1
    
    If remainder Mod 4 = 0 Then
        'Number of players checked in creates equal cards of 4.
        
        Do Until remainder = 0
            j = 0
            'Fill card #1
            If i < 4 Then
                For i = 0 To 3
                    Cells(12   j, 11) = playerArr(i)
                    remainder = remainder - 1
                    j = j   1
                Next i
            'Fill card #2
            ElseIf 4 <= i And i < 8 Then
                For i = 4 To 7
                    Cells(12   j, 16) = playerArr(i)
                    remainder = remainder - 1
                    j = j   1
                Next i
            'Fill card #3
            ElseIf 8 <= i And i < 12 Then
                For i = 8 To 11
                    Cells(19   j, 11) = playerArr(i)
                    remainder = remainder - 1
                    j = j   1
                Next i
            'Fill card #4
            ElseIf 12 <= i And i < 16 Then
                For i = 12 To 15
                    Cells(19   j, 16) = playerArr(i)
                    remainder = remainder - 1
                    j = j   1
                Next i
            'Fill card #5
            ElseIf 16 <= i And i < 20 Then
                For i = 16 To 19
                    Cells(26   j, 11) = playerArr(i)
                    remainder = remainder - 1
                    j = j   1
                Next i
            'Fill card #6
            ElseIf 20 <= i And i < 24 Then
                For i = 20 To 23
                    Cells(26   j, 16) = playerArr(i)
                    remainder = remainder - 1
                    j = j   1
                Next i
            'Fill card #7
            ElseIf 24 <= i And i < 28 Then
                For i = 24 To 27
                    Cells(33   j, 11) = playerArr(i)
                    remainder = remainder - 1
                    j = j   1
                Next i
            'Fill card #8
            ElseIf 28 <= i And i < 32 Then
                For i = 28 To 31
                    Cells(33   j, 16) = playerArr(i)
                    remainder = remainder - 1
                    j = j   1
                Next i
            'Fill card #9
            ElseIf 32 <= i And i < 36 Then
                For i = 32 To 35
                    Cells(40   j, 11) = playerArr(i)
                    remainder = remainder - 1
                    j = j   1
                Next i
            'Fill card #10
            ElseIf 36 <= i And i < 40 Then
                For i = 36 To 39
                    Cells(40   j, 16) = playerArr(i)
                    remainder = remainder - 1
                    j = j   1
                Next i
            'Fill card #11
            ElseIf 40 <= i And i < 44 Then
                For i = 40 To 43
                    Cells(47   j, 11) = playerArr(i)
                    remainder = remainder - 1
                    j = j   1
                Next i
            'Fill card #12
            ElseIf 44 <= i And i < 48 Then
                For i = 44 To 47
                    Cells(47   j, 16) = playerArr(i)
                    remainder = remainder - 1
                    j = j   1
                Next i
            End If
        Loop
            
        
    End If
            

End With

End Sub

CodePudding user response：

Maybe try this:

Sub DivideIntoCards(playerArr As Variant)

Dim wb As Workbook
Dim ws As Worksheet

Set wb = ThisWorkbook
Set ws = wb.ActiveSheet

Const PLAYER_PER_CARD = 3
Const START_ROW = 12
Const CARD_OFFSET = 7 'offset rows

cols = Array(11, 16) 'set predefined columns
    
players = UBound(playerArr) - LBound(playerArr)   1

If players Mod PLAYER_PER_CARD = 0 Then
    
    cardCount = CInt(players / PLAYER_PER_CARD) - 1
    rPL = START_ROW
    
    For card = 0 To cardCount
        
        m = card Mod 2 'determine odd/even card
        If m = 0 Then rPL = START_ROW   (card / 2) * CARD_OFFSET 'increase row on uneven cards
        
        cPL = cols(m) 'choose correct column, based on odd/even card
                    
        For i = 0 To PLAYER_PER_CARD - 1
            plIndex = card * PLAYER_PER_CARD   i
            ws.Cells(rPL   i, cPL) = playerArr(plIndex)
        Next i
        
    Next
Else

    Response = MsgBox("The player count of " & players & _
    " cannot be divided in equals groups of " & PLAYER_PER_CARD & _
    " players.", vbCritical, "Player count Error")
End If

End Sub