Sub CartProd8()
Dim CartSize(1 To 8) As Long
Dim I1 As Long, I2 As Long, I3 As Long, I4 As Long, _
I5 As Long, I6 As Long, I7 As Long, I8 As Long
Dim CurrentRow As Long, TotalRows As Long
'Disable Screen Updating (for speed)
Application.ScreenUpdating = False
'Clear Current List
Range(Cells(30, 1), Cells(Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row, 8)).Delete (xlShiftUp)
'Populate Size Array
For I1 = 1 To 8
CartSize(I1) = Cells(29, I1).End(xlUp).Row
Next I1
'Determine Finished Size
TotalRows = CartSize(1) * CartSize(2) * CartSize(3) * CartSize(4) * _
CartSize(5) * CartSize(6) * CartSize(7) * CartSize(8)
'Start at Row 30
CurrentRow = 30
'Copy Data - Loop Through Every Possibility
For I1 = 1 To CartSize(1)
For I2 = 1 To CartSize(2)
For I3 = 1 To CartSize(3)
For I4 = 1 To CartSize(4)
For I5 = 1 To CartSize(5)
For I6 = 1 To CartSize(6)
For I7 = 1 To CartSize(7)
For I8 = 1 To CartSize(8)
Cells(CurrentRow, 1) = Cells(I1, 1)
Cells(CurrentRow, 2) = Cells(I2, 2)
Cells(CurrentRow, 3) = Cells(I3, 3)
Cells(CurrentRow, 4) = Cells(I4, 4)
Cells(CurrentRow, 5) = Cells(I5, 5)
Cells(CurrentRow, 6) = Cells(I6, 6)
Cells(CurrentRow, 7) = Cells(I7, 7)
Cells(CurrentRow, 8) = Cells(I8, 8)
CurrentRow = CurrentRow + 1
'Display Status
Application.StatusBar = CurrentRow - 30 & "/" & TotalRows & _
" " & Format((CurrentRow - 30) / TotalRows, "0.0%")
Next I8
Next I7
Next I6
Next I5
Next I4
Next I3
Next I2
Next I1
'Clear StatusBar
Application.StatusBar = ""
'Enable Screen Updating
Application.ScreenUpdating = True
End Sub
