I have a snippet of code which can produce millions of records.
However only records that meet certain criteria is printed to the
worksheet.
The code gets extremely slow before completion and may even fail to
complete the task on a computer with 264MB of RAM.
One variable is set as currency because a "Long" causes an overflow
error.

Does the variable significantly affect the speed of the code?

There is also an array which is used over an over. Is it that this
becomes bloated?

Below is the code in Question. Any help in dramatically improving the
speed is greatly apreciated.

Dim NFavorites As Integer
Dim NElements As Integer
Dim maxLen As Currency
Dim Elements() As Integer
Dim outPut() As Integer
Dim subset, subsetcount As Long
Dim NumRng As Range
Dim chkNum As Integer
Dim Favorites() As Integer
Dim rowNum As Integer
Dim countSets As Long
Dim R As Variant
Dim v As Variant
Dim c As Variant
Dim cv As Integer
Dim X As Integer

Sub SubSets()
Set NumRng = Sheets("The Numbers").Range("A1:A180")
chkNum = Application.WorksheetFunction.CountA(NumRng)
On Error GoTo Terminate

NFavorites = InputBox("Please give the number of favorites",
"Selective Records", chkNum)

NElements = InputBox("Please give the number of elements of one
subset", "Selective Records", 10)
maxLen = Application.WorksheetFunction.Combin(NFavorites, NElements)
rowNum = 8
Application.StatusBar = ""
Application.EnableEvents = False

ReDim Elements(1 To NElements)
ReDim Favorites(1 To NFavorites) As Integer
ReDim outPut(1, 1 To NElements)
Range(Cells(8, 1), Cells(5000, NElements)).ClearContents

For N = 1 To NFavorites
Favorites(N) = NumRng(N)
Next N
For E = 1 To NElements
Elements(E) = E
Next E
Elements(NElements) = Elements(NElements) - 1
subset = 1
subsetcount = subset
N = 0

mark:
Elements(NElements - N) = Elements(NElements - N) + 1
For m = NElements - N + 1 To NElements
Elements(m) = Elements(m - 1) + 1
Next m
If Elements(NElements - N) = NFavorites - N + 1 Then
If N = NElements - 1 Then
endstring = Chr(13) & Chr(13) & "The calculation
is finished."
Exit Sub
End If
N = N + 1
GoTo mark
End If
For E = 1 To NElements
outPut(subset, E) = Favorites(Elements(E))
Next E
If rowNum = 8 Then
Range(Cells(rowNum, 1), Cells(rowNum, NElements)) =
outPut()
rowNum = rowNum + 1
subsetcount = subsetcount + 1
GoTo mark
End If
N = 0
For R = rowNum - 1 To 8 Step -1
For Each v In outPut()
X =
Application.WorksheetFunction.CountIf(Range(Cells( R, 1), Cells(R,
NElements)), v)
If X = 1 Then
cv = cv + 1
End If
'Prevent looping beyond what is
necesary
If cv Range("E4").Value Then
Exit For
Next v

If cv Range("E4").Value Then
cv = 0
GoTo NextMove
End If
cv = 0
Next R
Range(Cells(rowNum, 1), Cells(rowNum,
NElements)) = outPut()
rowNum = rowNum + 1
Application.StatusBar = "Records Processed: "
& rowNum - 8
cv = 0

NextMove:
subsetcount = subsetcount + 1
Range("A7") = "Processing Record # " &
Format(subsetcount, "#,##0") & " of " & Format(maxLen, "#,##0")

If subsetcount = maxLen Then
Application.EnableEvents = True
Application.ScreenUpdating = True
ThisWorkbook.Save
Exit Sub
End If
cv = 0
GoTo mark
'Exit program when cancel is clicked on the Input Box
Terminate:
Exit Sub
End Sub
DK Thanks.

If you explained what the intention of the code is, then maybe it would
become clear?

"Dnk" wrote in message
om...
I have a snippet of code which can produce millions of records.
However only records that meet certain criteria is printed to the
worksheet.
The code gets extremely slow before completion and may even fail to
complete the task on a computer with 264MB of RAM.
One variable is set as currency because a "Long" causes an overflow
error.

Does the variable significantly affect the speed of the code?

There is also an array which is used over an over. Is it that this
becomes bloated?

Below is the code in Question. Any help in dramatically improving the
speed is greatly apreciated.

Dim NFavorites As Integer
Dim NElements As Integer
Dim maxLen As Currency
Dim Elements() As Integer
Dim outPut() As Integer
Dim subset, subsetcount As Long
Dim NumRng As Range
Dim chkNum As Integer
Dim Favorites() As Integer
Dim rowNum As Integer
Dim countSets As Long
Dim R As Variant
Dim v As Variant
Dim c As Variant
Dim cv As Integer
Dim X As Integer

Sub SubSets()
Set NumRng = Sheets("The Numbers").Range("A1:A180")
chkNum = Application.WorksheetFunction.CountA(NumRng)
On Error GoTo Terminate

NFavorites = InputBox("Please give the number of favorites",
"Selective Records", chkNum)

NElements = InputBox("Please give the number of elements of one
subset", "Selective Records", 10)
maxLen = Application.WorksheetFunction.Combin(NFavorites, NElements)
rowNum = 8
Application.StatusBar = ""
Application.EnableEvents = False

ReDim Elements(1 To NElements)
ReDim Favorites(1 To NFavorites) As Integer
ReDim outPut(1, 1 To NElements)
Range(Cells(8, 1), Cells(5000, NElements)).ClearContents

For N = 1 To NFavorites
Favorites(N) = NumRng(N)
Next N
For E = 1 To NElements
Elements(E) = E
Next E
Elements(NElements) = Elements(NElements) - 1
subset = 1
subsetcount = subset
N = 0

mark:
Elements(NElements - N) = Elements(NElements - N) + 1
For m = NElements - N + 1 To NElements
Elements(m) = Elements(m - 1) + 1
Next m
If Elements(NElements - N) = NFavorites - N + 1 Then
If N = NElements - 1 Then
endstring = Chr(13) & Chr(13) & "The calculation
is finished."
Exit Sub
End If
N = N + 1
GoTo mark
End If
For E = 1 To NElements
outPut(subset, E) = Favorites(Elements(E))
Next E
If rowNum = 8 Then
Range(Cells(rowNum, 1), Cells(rowNum, NElements)) =
outPut()
rowNum = rowNum + 1
subsetcount = subsetcount + 1
GoTo mark
End If
N = 0
For R = rowNum - 1 To 8 Step -1
For Each v In outPut()
X =
Application.WorksheetFunction.CountIf(Range(Cells( R, 1), Cells(R,
NElements)), v)
If X = 1 Then
cv = cv + 1
End If
'Prevent looping beyond what is
necesary
If cv Range("E4").Value Then
Exit For
Next v

If cv Range("E4").Value Then
cv = 0
GoTo NextMove
End If
cv = 0
Next R
Range(Cells(rowNum, 1), Cells(rowNum,
NElements)) = outPut()
rowNum = rowNum + 1
Application.StatusBar = "Records Processed: "
& rowNum - 8
cv = 0

NextMove:
subsetcount = subsetcount + 1
Range("A7") = "Processing Record # " &
Format(subsetcount, "#,##0") & " of " & Format(maxLen, "#,##0")

If subsetcount = maxLen Then
Application.EnableEvents = True
Application.ScreenUpdating = True
ThisWorkbook.Save
Exit Sub
End If
cv = 0
GoTo mark
'Exit program when cancel is clicked on the Input Box
Terminate:
Exit Sub
End Sub
DK Thanks.

Variable size will make a difference. Here is a site that lets you know a lot
about speeding up code and spreadsheets. There is also a section on Memory...

http://www.decisionmodels.com/index.htm

Excel can only reference a certain amount of memory regardless of your ram.
2000 is about 160 Mb while 2003 is about 1Gb. It is always a good idea to use
the most efficient variables you can. You have some variants which are the
least efficient variables going.

HTH
"Dnk" wrote:

I have a snippet of code which can produce millions of records.
However only records that meet certain criteria is printed to the
worksheet.
The code gets extremely slow before completion and may even fail to
complete the task on a computer with 264MB of RAM.
One variable is set as currency because a "Long" causes an overflow
error.

Does the variable significantly affect the speed of the code?

There is also an array which is used over an over. Is it that this
becomes bloated?

Below is the code in Question. Any help in dramatically improving the
speed is greatly apreciated.

Dim NFavorites As Integer
Dim NElements As Integer
Dim maxLen As Currency
Dim Elements() As Integer
Dim outPut() As Integer
Dim subset, subsetcount As Long
Dim NumRng As Range
Dim chkNum As Integer
Dim Favorites() As Integer
Dim rowNum As Integer
Dim countSets As Long
Dim R As Variant
Dim v As Variant
Dim c As Variant
Dim cv As Integer
Dim X As Integer

Sub SubSets()
Set NumRng = Sheets("The Numbers").Range("A1:A180")
chkNum = Application.WorksheetFunction.CountA(NumRng)
On Error GoTo Terminate

NFavorites = InputBox("Please give the number of favorites",
"Selective Records", chkNum)

NElements = InputBox("Please give the number of elements of one
subset", "Selective Records", 10)
maxLen = Application.WorksheetFunction.Combin(NFavorites, NElements)
rowNum = 8
Application.StatusBar = ""
Application.EnableEvents = False

ReDim Elements(1 To NElements)
ReDim Favorites(1 To NFavorites) As Integer
ReDim outPut(1, 1 To NElements)
Range(Cells(8, 1), Cells(5000, NElements)).ClearContents

For N = 1 To NFavorites
Favorites(N) = NumRng(N)
Next N
For E = 1 To NElements
Elements(E) = E
Next E
Elements(NElements) = Elements(NElements) - 1
subset = 1
subsetcount = subset
N = 0

mark:
Elements(NElements - N) = Elements(NElements - N) + 1
For m = NElements - N + 1 To NElements
Elements(m) = Elements(m - 1) + 1
Next m
If Elements(NElements - N) = NFavorites - N + 1 Then
If N = NElements - 1 Then
endstring = Chr(13) & Chr(13) & "The calculation
is finished."
Exit Sub
End If
N = N + 1
GoTo mark
End If
For E = 1 To NElements
outPut(subset, E) = Favorites(Elements(E))
Next E
If rowNum = 8 Then
Range(Cells(rowNum, 1), Cells(rowNum, NElements)) =
outPut()
rowNum = rowNum + 1
subsetcount = subsetcount + 1
GoTo mark
End If
N = 0
For R = rowNum - 1 To 8 Step -1
For Each v In outPut()
X =
Application.WorksheetFunction.CountIf(Range(Cells( R, 1), Cells(R,
NElements)), v)
If X = 1 Then
cv = cv + 1
End If
'Prevent looping beyond what is
necesary
If cv Range("E4").Value Then
Exit For
Next v

If cv Range("E4").Value Then
cv = 0
GoTo NextMove
End If
cv = 0
Next R
Range(Cells(rowNum, 1), Cells(rowNum,
NElements)) = outPut()
rowNum = rowNum + 1
Application.StatusBar = "Records Processed: "
& rowNum - 8
cv = 0

NextMove:
subsetcount = subsetcount + 1
Range("A7") = "Processing Record # " &
Format(subsetcount, "#,##0") & " of " & Format(maxLen, "#,##0")

If subsetcount = maxLen Then
Application.EnableEvents = True
Application.ScreenUpdating = True
ThisWorkbook.Save
Exit Sub
End If
cv = 0
GoTo mark
'Exit program when cancel is clicked on the Input Box
Terminate:
Exit Sub
End Sub
DK Thanks.

I suspect it's down to your input combinations and result of "COMBIN". Which
would explain your overflow, and why even with a great bunch of ram it could
be time to take a holiday while your code is processing.

Regards,
Peter T

"Dnk" wrote in message
om...
I have a snippet of code which can produce millions of records.
However only records that meet certain criteria is printed to the
worksheet.
The code gets extremely slow before completion and may even fail to
complete the task on a computer with 264MB of RAM.
One variable is set as currency because a "Long" causes an overflow
error.

Does the variable significantly affect the speed of the code?

There is also an array which is used over an over. Is it that this
becomes bloated?

Below is the code in Question. Any help in dramatically improving the
speed is greatly apreciated.

Dim NFavorites As Integer
Dim NElements As Integer
Dim maxLen As Currency
Dim Elements() As Integer
Dim outPut() As Integer
Dim subset, subsetcount As Long
Dim NumRng As Range
Dim chkNum As Integer
Dim Favorites() As Integer
Dim rowNum As Integer
Dim countSets As Long
Dim R As Variant
Dim v As Variant
Dim c As Variant
Dim cv As Integer
Dim X As Integer

Sub SubSets()
Set NumRng = Sheets("The Numbers").Range("A1:A180")
chkNum = Application.WorksheetFunction.CountA(NumRng)
On Error GoTo Terminate

NFavorites = InputBox("Please give the number of favorites",
"Selective Records", chkNum)

NElements = InputBox("Please give the number of elements of one
subset", "Selective Records", 10)
maxLen = Application.WorksheetFunction.Combin(NFavorites, NElements)
rowNum = 8
Application.StatusBar = ""
Application.EnableEvents = False

ReDim Elements(1 To NElements)
ReDim Favorites(1 To NFavorites) As Integer
ReDim outPut(1, 1 To NElements)
Range(Cells(8, 1), Cells(5000, NElements)).ClearContents

For N = 1 To NFavorites
Favorites(N) = NumRng(N)
Next N
For E = 1 To NElements
Elements(E) = E
Next E
Elements(NElements) = Elements(NElements) - 1
subset = 1
subsetcount = subset
N = 0

mark:
Elements(NElements - N) = Elements(NElements - N) + 1
For m = NElements - N + 1 To NElements
Elements(m) = Elements(m - 1) + 1
Next m
If Elements(NElements - N) = NFavorites - N + 1 Then
If N = NElements - 1 Then
endstring = Chr(13) & Chr(13) & "The calculation
is finished."
Exit Sub
End If
N = N + 1
GoTo mark
End If
For E = 1 To NElements
outPut(subset, E) = Favorites(Elements(E))
Next E
If rowNum = 8 Then
Range(Cells(rowNum, 1), Cells(rowNum, NElements)) =
outPut()
rowNum = rowNum + 1
subsetcount = subsetcount + 1
GoTo mark
End If
N = 0
For R = rowNum - 1 To 8 Step -1
For Each v In outPut()
X =
Application.WorksheetFunction.CountIf(Range(Cells( R, 1), Cells(R,
NElements)), v)
If X = 1 Then
cv = cv + 1
End If
'Prevent looping beyond what is
necesary
If cv Range("E4").Value Then
Exit For
Next v

If cv Range("E4").Value Then
cv = 0
GoTo NextMove
End If
cv = 0
Next R
Range(Cells(rowNum, 1), Cells(rowNum,
NElements)) = outPut()
rowNum = rowNum + 1
Application.StatusBar = "Records Processed: "
& rowNum - 8
cv = 0

NextMove:
subsetcount = subsetcount + 1
Range("A7") = "Processing Record # " &
Format(subsetcount, "#,##0") & " of " & Format(maxLen, "#,##0")

If subsetcount = maxLen Then
Application.EnableEvents = True
Application.ScreenUpdating = True
ThisWorkbook.Save
Exit Sub
End If
cv = 0
GoTo mark
'Exit program when cancel is clicked on the Input Box
Terminate:
Exit Sub
End Sub
DK Thanks.