Hi,
Latest post before I head home -- no output yet, and you might get caught in a loop -- hit Esc to break out.
Also, I have Excel 97 at work, so I had to use the Split97 UDF function. For those on 2000 or XP, Excel has a native Split function.
OK, more to come as this gets refined...
<pre>Sub test()
Dim x As Integer, y As Integer
Dim i As Integer, j As Integer, k As Integer, counter As Long
Dim m As Long, n As Long, p As Long, q As Long
Dim z As String
Dim UsedList
Dim fn As WorksheetFunction
Dim ScheduleArray
Dim Schedule As New Collection
Randomize
Set fn = Application.WorksheetFunction
x = 14
y = 2
m = (x - 1) * 2
n = x / y
ReDim ScheduleArray(1 To m, 1 To n, 1 To 2) As Integer
ReDim UsedList(1 To x)
For i = 1 To x
For j = 1 To x
If i <> j Then
z = i & "," & j
Schedule.Add Split97(z, ",")
End If
Next j
Next i
For q = 1 To m * n
If counter Mod 7 = 0 Then
k = k + 1
Application.StatusBar = k
counter = 1
Else
counter = counter + 1
End If
If counter = 1 Then
ReDim UsedList(1 To x)
p = Int(Rnd() * Schedule.Count) + 1
ScheduleArray(k, counter, 1) = CInt(Schedule.Item(p)(0))
ScheduleArray(k, counter, 2) = CInt(Schedule.Item(p)(1))
UsedList(1) = CInt(Schedule.Item(p)(0))
UsedList(2) = CInt(Schedule.Item(p)(1))
Else
ReSample:
p = Int(Rnd() * Schedule.Count) + 1
If Not IsError(Application.Match(CInt(Schedule.Item(p)(0)), UsedList, 0)) Then GoTo ReSample
If Not IsError(Application.Match(CInt(Schedule.Item(p)(1)), UsedList, 0)) Then GoTo ReSample
ScheduleArray(k, counter, 1) = CInt(Schedule.Item(p)(0))
ScheduleArray(k, counter, 2) = CInt(Schedule.Item(p)(1))
UsedList(2 * counter - 1) = CInt(Schedule.Item(p)(0))
UsedList(2 * counter) = CInt(Schedule.Item(p)(1))
Schedule.Remove (p)
End If
Next q
'Range("A1").Resize(m, n) = ScheduleArray
'Range("A1").Resize(n, m) = fn.Transpose(ScheduleArray)
Application.StatusBar = False
End Sub
Function Split97(sString As String, Optional sDelim As String = " ", _
Optional ByVal Limit As Long = -1, _
Optional Compare As Long = vbBinaryCompare) As Variant
''''''''''''''''''''''''''''
' Split97 mirrors the Split function introduced in XL2000
' Author Myrna Larson
' posted to microsoft.public.excel.programming 13 Nov 2001
Dim vOut As Variant, StrLen As Long
Dim DelimLen As Long, Lim As Long
Dim n As Long, p1 As Long, p2 As Long
StrLen = Len(sString)
DelimLen = Len(sDelim)
ReDim vOut(0 To 0)
If StrLen = 0 Or Limit = 0 Then
' return array with 1 element which is empty
ElseIf DelimLen = 0 Then
vOut(0) = sString ' return whole string in first array element
Else
Limit = Limit - 1 ' adjust from count to offset
n = -1
p1 = 1
Do While p1 <= StrLen
p2 = InStr(p1, sString, sDelim, Compare)
If p2 = 0 Then p2 = StrLen + 1
n = n + 1
If n > 0 Then ReDim Preserve vOut(0 To n)
If n = Limit Then
vOut
= Mid$(sString, p1) ' last element contains entire tail
Exit Do
Else
vOut
= Mid$(sString, p1, p2 - p1) ' extract this piece of string
End If
p1 = p2 + DelimLen ' advance start past delimiter
Loop
End If
Split97 = vOut
End Function</pre>
