Sub Button1_WordGenerate()
Dim currRow As Integer
Dim currWriteRow As Long
Dim currWriteCol As Long
Dim numStudents As Long
Dim wordsPer As Long
Dim totalWords As Long
Dim fakeNum As Integer
currWriteRow = 2
currWriteCol = 2
Dim currWord As String
Dim maxWords As Long
maxWords = 40320
numStudents = 30
wordsPer = maxWords / numStudents
totalWords = 0
For Z = 2 To numStudents + 1
Cells(1, Z).Value = "Student " & Z - 1
Next Z
For a = 1 To 8
For b = 1 To 8
For c = 1 To 8
For d = 1 To 8
For e = 1 To 8
For f = 1 To 8
For g = 1 To 8
For h = 1 To 8
If a = b Or a = c Or a = d Or a = e Or a = f Or a = g Or a = h Then
GoTo EndOfLoop
ElseIf b = c Or b = d Or b = e Or b = f Or b = g Or b = h Then
GoTo EndOfLoop
ElseIf c = d Or c = e Or c = f Or c = g Or c = h Then
GoTo EndOfLoop
ElseIf d = e Or d = f Or d = g Or d = h Then
GoTo EndOfLoop
ElseIf e = f Or e = g Or e = h Then
GoTo EndOfLoop
ElseIf f = g Or f = h Then
GoTo EndOfLoop
ElseIf g = h Then
GoTo EndOfLoop
Else
currWord = Cells(a, 1).Value + Cells(b, 1).Value + Cells(c, 1).Value + Cells(d, 1).Value + Cells(e, 1).Value + Cells(f, 1).Value + Cells(g, 1).Value + Cells(h, 1).Value
Cells(currWriteRow, currWriteCol).Value = currWord
totalWords = totalWords + 1
If currWriteRow = wordsPer + 1 Then
currWriteCol = currWriteCol + 1
currWriteRow = 2
Else
currWriteRow = currWriteRow + 1
End If
If totalWords >= maxWords Then
GoTo EndOfMacro
End If
End If
EndOfLoop: fakeNum = 50
Next h
Next g
Next f
Next e
Next d
Next c
Next b
Next a
EndOfMacro: fakeNum = 10
End Sub
