I am requesting the help of some one to revised this code to have the
the same process done in an array and then the result is put on the
worksheet.

I have tried unsucessfully to revised the code myself.
The code is a bit complicated but if there is some one who is willing
to help I can send a copy of the Excel file and it would be much
easier to see what the code is doing.
Basically it searches for every possible combination of a specified
set of numbers and if the numbers in the following set does not
repeated it self more that a specified number of time the subset is
placed on the worksheet.
Dk
Option Base 1
Dim NFavorites As Byte 'Number of Favoritess
Dim NElements As Byte 'Number of elements in one subset
Dim maxLen As Double
Dim Elements() As Integer
Dim outPut() As Integer
Dim subset As Byte, subsetcount As Currency
Dim NumRng As Range
Dim chkNum As Byte
Dim Favorites() As Integer
Dim rowNum As Integer
Dim R As Integer
Dim v As Variant
Dim C As Variant
Dim cv As Byte, x As Byte

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", 8)
maxLen = Application.WorksheetFunction.Combin(NFavorites, NElements)
rowNum = 9
Application.StatusBar = ""
Range("A7") = maxLen
Application.EnableEvents = False

ReDim Elements(1 To NElements) As Integer
ReDim Favorites(1 To NFavorites) As Integer
ReDim outPut(1, 1 To NElements) As Integer

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
'Put the first row on worksheet
If rowNum = 9 Then
Range(Cells(rowNum, 1), Cells(rowNum, NElements)) =
outPut()
rowNum = rowNum + 1
maxLen = maxLen - 1
GoTo mark
End If
N = 0

'Loop thru existing rows to make sure each no. occurs
not 4 times
For R = rowNum - 1 To 8 Step -1
For Each v In outPut
'check the row on the worksheet
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
cv = 0
GoTo NextMove
End If
Next v

cv = 0
Next R
Range(Cells(rowNum, 1), Cells(rowNum,
NElements)) = outPut()
rowNum = rowNum + 1
cv = 0
NextMove:
subsetcount = subsetcount + 1
maxLen = maxLen - 1
Application.StatusBar = "Processed : " &
Format(subsetcount, "#,##0") & " Remaining: " & Format(maxLen,
"#,##0") & " Complete : " & Format(subsetcount / Range("A7"),
"0.0000%")

If maxLen = 0 Then
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Range("A1") = "Records: " & Format(subsetcount, "#,##0")
ThisWorkbook.Save
Exit Sub
End If
cv = 0
GoTo mark
Terminate:
Exit Sub
End Sub