Hi Paul,
I've tried use the below but for "aData(i) = Array("5L", "5R", "4L", "4R", "3L", "3R", "B2", "B3", "B4")" as this is exactly what I need to find however it's not seems to be working. VBA is new to me so going through trial and error here. Would you be able to point what I'm doing wrong please?

Quote Originally Posted by Paul_Hossler View Post
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