I have a recursive routine that does this, if I understand you right.
It isn't perfect but it works. A small bug causes one extra incomplete
row at the end of the output table. Not worth it for me to fix. Just
delete that row.
The input data must be on Sheet1. Column A has the "title" for each
row. This will become the title of each column in sheet 2. Put as many
data items in each row and as many rows as you need, but don't leave any
blank cells or rows in the middle because the loops go until they see a
blank.
Example of sheet1:
A B C D E F G H I J
1 Inning 1 2 3 4 5 6 7 8 ...etc
2 Half Top Bottom
3 Out 0 1 2
4 Runners None 1st 2nd 3rd 1st&2nd 2nd&3rd ....etc
5 HitType Fly ..etc
6 HitTo 1st 2nd Short 3rd Left .....etc
7 etc..
8 end with a blank row!
As many rows with as many columns as you like, as long as there are less
than 65536 combinations.
The output table of all combinations will be on sheet 2. Any data on
sheet 2 will be lost! I suggest using a new, blank worksheet with only
a copy your input table on sheet 1. That way if the macro screws up,
nothing is lost.
Here's the code. Run sub main to try it. Watch out for line wrap.
Reply if you need more help.
Len
Option Explicit
Sub main()
'input data is on sheet 1.
'output to sheet 2
'Note: existing data on sheet 2 will be deleted!
Dim intColumn As Integer
Dim strTemp As String
Dim intI As Integer ' a counter
Worksheets("Sheet2").Activate
Cells.ClearContents
Range("A2").Activate
'Put headings on sheet2.
Worksheets("Sheet1").Activate
intI = 1
strTemp = Cells(intI, 1).Value
Do While Len(strTemp) > 0
Worksheets("Sheet2").Cells(1, intI).Value = strTemp
intI = intI + 1
strTemp = Cells(intI, 1).Value
Loop
Worksheets("Sheet2").Activate
Range("A2").Activate
intColumn = 2
strTemp = Trim(Worksheets("Sheet1").Cells(1, intColumn).Value)
Do While Len(strTemp) > 0
MakeCombos 2, strTemp
intColumn = intColumn + 1
strTemp = Trim(Worksheets("Sheet1").Cells(1, intColumn).Value)
Loop
End Sub
Sub MakeCombos(lngStartRow As Long, strPreviousItem As String)
Dim intColumn As Integer
Dim intJ As Integer 'a counter
Dim strThisItem As String
'Recursive calls will create all combinations of
' strPreviousItem with all filled cells lngStartRow and
' in all rows below.
intColumn = 2
Cells(ActiveCell.Row, lngStartRow - 1).Value = strPreviousItem
strThisItem = _
Worksheets("Sheet1").Cells(lngStartRow, intColumn).Value
Do While Len(Trim(strThisItem)) > 0
MakeCombos lngStartRow + 1, strThisItem
intColumn = intColumn + 1
strThisItem = _
Worksheets("Sheet1").Cells(lngStartRow, intColumn).Value
If Len(Trim(Worksheets("Sheet1").Cells(lngStartRow + 1, 1).Value)) _
= 0 Then
'last item, start a new row
ActiveCell.Offset(1, 0).Activate
For intJ = 1 To lngStartRow - 1
Cells(ActiveCell.Row, intJ).Value = _
Cells(ActiveCell.Row - 1, intJ).Value
Next
End If
Loop
End Sub
