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.