A
Andreas
Hi,
I use the following macro and it used to run fine - until yesterday.
Then, I had to manually stop it (using the windows task manager). Now,
t's not working anymore. Well, it seems as if it's still working, but
the output file is not created.
Any ideas about the problem? Thanks,
Andreas
Sub test()
ListCombos Range("A1:A5"), 3, "Output.csv"
End Sub
Sub ListCombos(r As Range, ByVal m As Long, sFile As String)
' lists the combinations of r choose m to file sFile
' r is a single-column or single-row range
Dim ai() As Long
Dim i As Long
Dim n As Long
Dim sOut As String
Dim iFF As Integer
If r Is Nothing Then Exit Sub
If r.Rows.Count <> 1 And r.Columns.Count <> 1 Then Exit Sub
n = r.Count
If m < 1 Then Exit Sub
If m > n Then m = n
iFF = FreeFile
Open sFile For Output As #iFF
Redim ai(1 To m)
ai(1) = 0
For i = 2 To m
ai(i) = i
Next i
Do
For i = 1 To m - 1
If ai(i) + 1 < ai(i + 1) Then
ai(i) = ai(i) + 1
Exit For
Else
ai(i) = i
End If
Next i
If i = m Then
If ai(m) < n Then
ai(m) = ai(m) + 1
Else
Exit Do
End If
End If
' catenate and write to file
sOut = vbNullString
For i = 1 To m
sOut = sOut & r(ai(i)).Text & ","
Next i
Write #iFF, Left(sOut, Len(sOut) - 1)
Loop
Close #iFF
End Sub
I use the following macro and it used to run fine - until yesterday.
Then, I had to manually stop it (using the windows task manager). Now,
t's not working anymore. Well, it seems as if it's still working, but
the output file is not created.
Any ideas about the problem? Thanks,
Andreas
Sub test()
ListCombos Range("A1:A5"), 3, "Output.csv"
End Sub
Sub ListCombos(r As Range, ByVal m As Long, sFile As String)
' lists the combinations of r choose m to file sFile
' r is a single-column or single-row range
Dim ai() As Long
Dim i As Long
Dim n As Long
Dim sOut As String
Dim iFF As Integer
If r Is Nothing Then Exit Sub
If r.Rows.Count <> 1 And r.Columns.Count <> 1 Then Exit Sub
n = r.Count
If m < 1 Then Exit Sub
If m > n Then m = n
iFF = FreeFile
Open sFile For Output As #iFF
Redim ai(1 To m)
ai(1) = 0
For i = 2 To m
ai(i) = i
Next i
Do
For i = 1 To m - 1
If ai(i) + 1 < ai(i + 1) Then
ai(i) = ai(i) + 1
Exit For
Else
ai(i) = i
End If
Next i
If i = m Then
If ai(m) < n Then
ai(m) = ai(m) + 1
Else
Exit Do
End If
End If
' catenate and write to file
sOut = vbNullString
For i = 1 To m
sOut = sOut & r(ai(i)).Text & ","
Next i
Write #iFF, Left(sOut, Len(sOut) - 1)
Loop
Close #iFF
End Sub