hi,

i have tried but its showing error

using the following sheet

Col 1 | Col 2 |

p | 10 |

Combinations | FALSE |

Repetition | TRUE |

| |

Set | 0 |

| 1 |

| 2 |

| 3 |

| 4 |

| 5 |

| 6 |

| 7 |

| 8 |

| 9 |

<colgroup><col><col></colgroup><tbody>

</tbody>

using this code

Option Explicit

' PGC Set 2007

' Calculates and writes the Combinations / Permutations with/without repetition

' Assumes the result is written from row 1 down. If the total number of cells in a column

' is less than tha number of results continues in another group of columns to the right.

' vElements - Array with the set elements (1 to n)

' p - number of elements in 1 combination/permutation

' bComb - True: Combinations, False: Permutations

' bRepet - True: with repetition, False: without repetition

' vResult - Array to hold 1 permutation/combination (1 to p)

' lRow - row number. the next combination/permutation is written in lRow+1

' vResultAll - Array to hold all the permutations/combinations (1 to Total, 1 to p)

' iElement - order of the element to process in case of combination

' iIndex - position of the next element in the combination/permutation

' Sub CombPerm() deals with the input / output

' Sub CombPermNP() generates the combinations / permutations

Sub CombPerm()

Dim rRng As Range, p As Integer

Dim vElements As Variant, vResult As Variant, vResultAll As Variant, lTotal As Long

Dim lRow As Long, bComb As Boolean, bRepet As Boolean

Dim vResultPart, iGroup As Integer, l As Long, lMax As Long, k As Long

' Get the inputs and clear the result range (you may adjust for other locations)

Set rRng = Range("B5", Range("B5").End(xlDown)) ' The set of numbers

p = Range("B1").Value ' How many are picked

bComb = Range("B2")

bRepet = Range("B3")

Range("D1", Cells(1, Columns.Count)).EntireColumn.Clear

' Error

If (Not bRepet) And (rRng.Count < p) Then

MsgBox "With no repetition the number of elements of the set must be bigger or equal to p"

Exit Sub

End If

' Set up the arrays for the set elements and the result

vElements = Application.Index(Application.Transpose(rRng), 1, 0)

With Application.WorksheetFunction

If bComb = True Then

lTotal = .Combin(rRng.Count + IIf(bRepet, p - 1, 0), p)

Else

If bRepet = False Then lTotal = .Permut(rRng.Count, p) Else lTotal = rRng.Count ^ p

End If

End With

ReDim vResult(1 To p)

ReDim vResultAll(1 To lTotal, 1 To p)

' Calculate the Combinations / Permutations

Call CombPermNP(vElements, p, bComb, bRepet, vResult, lRow, vResultAll, 1, 1)

' Write the Combinations / Permutations

' Since writing to the worksheet cell be cell is very slow, uses temporary arrays to write one column at a time

Application.ScreenUpdating = False

If lTotal <= Rows.Count Then

Range("D1").Resize(lTotal, p).Value = vResultAll

Else

While iGroup * Rows.Count < lTotal

lMax = lTotal - iGroup * Rows.Count

If lMax > Rows.Count Then lMax = Rows.Count

ReDim vResultPart(1 To lMax, 1 To p)

For l = 1 To lMax

For k = 1 To p

vResultPart(l, k) = vResultAll(l + iGroup * Rows.Count, k)

Next k

Next

Range("D1").Offset(0, iGroup * (p + 1)).Resize(lMax, p).Value = vResultPart

iGroup = iGroup + 1

Wend

End If

Application.ScreenUpdating = True

End Sub

Sub CombPermNP(ByVal vElements As Variant, ByVal p As Integer, ByVal bComb As Boolean, ByVal bRepet As Boolean, _

ByVal vResult As Variant, ByRef lRow As Long, ByRef vResultAll As Variant, ByVal iElement As Integer, ByVal iIndex As Integer)

Dim i As Integer, j As Integer, bSkip As Boolean

For i = IIf(bComb, iElement, 1) To UBound(vElements)

bSkip = False

' in case of permutation without repetition makes sure the element is not yet used

If (Not bComb) And Not bRepet Then

For j = 1 To p

If vElements(i) = vResult(j) And Not IsEmpty(vResult(j)) Then

bSkip = True

Exit For

End If

Next

End If

If Not bSkip Then

vResult(iIndex) = vElements(i)

If iIndex = p Then

lRow = lRow + 1

For j = 1 To p

vResultAll(lRow, j) = vResult(j)

Next j

Else

Call CombPermNP(vElements, p, bComb, bRepet, vResult, lRow, vResultAll, i + IIf(bComb And bRepet, 0, 1), iIndex + 1)

End If

End If

Next i

End Sub