Originally Posted by
Paul_Hossler
My effort
[vba]
Option Explicit
Option Base 1
Sub Test1()
Dim iNumber As Long
Dim iCol As Long, iRow As Long
Dim s As String
Dim i As Long, j As Long
Dim aIndex() As Long
Dim aData() As Variant
Dim bDone As Boolean
iNumber = InputBox("How Many?, 0 to exit")
If iNumber < 1 Then Exit Sub
If iNumber > 16 Then Exit Sub
'this just uses intgers for demo, but
'aData could = Array("CA", "NY", "PA", "NJ", ....)
ReDim aData(1 To iNumber)
For i = 1 To iNumber
aData(i) = i
Next i
'clear working area
ActiveSheet.Cells(1, 1).CurrentRegion.ClearContents
'columns = C(iNumber, iCol)
For iCol = 1 To iNumber
'start in first row of iCol
iRow = 1
'add C(N, iCol) as header
ActiveSheet.Cells(iRow, iCol).Value = "C(" & iNumber & "," & iCol & ")"
Select Case iCol
Case 1
For i = 1 To iNumber
ActiveSheet.Cells(i + 1, iCol).Value = "{" & aData(i) & "}"
Next i
Case iNumber
s = vbNullString
For i = 1 To iNumber - 1
s = aData(i) & ","
Next i
ActiveSheet.Cells(2, iCol).Value = "{" & s & aData(iNumber) & "}"
Case Else
'init the index array to hold starting positions (1) and the max positon (2)
'N = 12, T = 4
'ABCDEFGHIJKL
' ^^^^ so N-T+1 = 9,10,11,12 or I,J,K,L
ReDim aIndex(1 To iCol, 1 To 2)
For i = 1 To iCol
aIndex(i, 1) = i
aIndex(i, 2) = iNumber - iCol + i
Next i
bDone = False
While Not bDone
'do first one
s = aData(aIndex(1, 1))
For i = 2 To iCol
s = s & "," & aData(aIndex(i, 1))
Next i
iRow = iRow + 1
ActiveSheet.Cells(iRow, iCol).Value = "{" & s & "}"
If aIndex(iCol, 1) <> aIndex(iCol, 2) Then
aIndex(iCol, 1) = aIndex(iCol, 1) + 1
Else
j = iCol
While aIndex(j, 1) = aIndex(j, 2) And j > 0
j = j - 1
If j = 1 Then GoTo NextCol
Wend
'bump the highest order, not-maxed out index
aIndex(j, 1) = aIndex(j, 1) + 1
For i = j + 1 To iCol
aIndex(i, 1) = aIndex(i - 1, 1) + 1
Next i
End If
'when the first index exceeds the last possible starting position, we're done
If aIndex(1, 1) > aIndex(1, 2) Then bDone = True
Wend
End Select
NextCol:
Next iCol
End Sub
[/vba]
There's a little more brute force ('inelagance') than I'd like, so maybe some others can offer clean up suggestions
Paul