Function nPr(ByVal n As Long, ByVal r As Long, _
    Optional ByVal Conbination As Boolean = False, _
    Optional ByVal Limit As Long = &H10000) As Variant
    
    Dim b() As Long, d As Long, i As Long, j As Long
    Dim m As Double

    On Error GoTo ErrorHandler

    ReDim a(1 To r) As Long
        
    If Conbination Then
         m = 1
         For i = 1 To r
             m = m * (n - i + 1) / i
         Next
    Else
         m = n ^ r
    End If

    If m > Limit Then m = Limit
    ReDim b(1 To m, 1 To r)
    i = 0
    d = 1
    a(1) = 1
    Do
        If a(d) > n Then
            d = d - 1
            If d = 0 Then Exit Do
            a(d) = a(d) + 1
        ElseIf d < r Then
            d = d + 1
            If Conbination Then a(d) = a(d - 1) + 1 Else a(d) = 1
        Else
            i = i + 1
            If i > m Then Exit Do
            For j = 1 To r
                b(i, j) = a(j)
            Next
            a(d) = a(d) + 1
        End If
    Loop
    nPr = b
    Exit Function

ErrorHandler:
    Exit Function
End Function



Sub Permutations()
    Dim n As Long, r As Long, i As Long, j As Long
    Dim sTitle As String, sDefault As String
    Dim vRet As Variant, a As Variant, buf As Variant
    Dim rng As Range

    vRet = MsgBox("Select permutations:[Yes] or combinations:[No].", _
        vbYesNoCancel Or vbQuestion)
    Select Case vRet
        Case vbYes: sTitle = "Permutations"
        Case vbNo: sTitle = "Combinations"
        Case Else: Exit Sub
    End Select

    vRet = MsgBox("Do you want " & LCase(sTitle) & " of cell values?", _
        vbYesNoCancel Or vbQuestion)
    Select Case vRet
        Case vbYes
            If TypeName(Selection) = "Range" Then
                sDefault = Selection.Address
            End If
            On Error Resume Next
            Set rng = Application.InputBox( _
                Prompt:="Select the cell range.", _
                Default:=sDefault, Title:=sTitle, Type:=8)
            On Error GoTo 0
            If rng Is Nothing Then Exit Sub
            n = rng.Count
        Case vbNo
            vRet = Application.InputBox( _
                Prompt:="Input the number of things.", _
                Title:=sTitle, Type:=1)
            If VarType(vRet) = vbBoolean Then Exit Sub
            n = vRet
        Case Else
            Exit Sub
    End Select

    vRet = Application.InputBox( _
        Prompt:="Input the number of taken.", _
        Title:=sTitle, Type:=1)
    If VarType(vRet) = vbBoolean Then Exit Sub
    r = vRet

    a = nPr(n, r, (sTitle = "Combinations"))

    If IsArray(a) Then
        If rng Is Nothing Then
            buf = a
        Else
            ReDim buf(1 To UBound(a), 1 To UBound(a, 2))
            For i = 1 To UBound(a)
                For j = 1 To UBound(a, 2)
                    buf(i, j) = rng(a(i, j))
                Next
            Next
        End If
        Workbooks.Add xlWorksheet
        ActiveSheet.Cells(1).Resize(UBound(a), UBound(a, 2)) = buf
    Else
        MsgBox "Fail to generate " & LCase(sTitle), vbExclamation
    End If

End Sub