Function to find the next permutation after a given permutation in Excel. The function NextPerm is used as in the following example: =NextPerm("acdeb") This gives the result acebd. The function can be used to produce a list of permutations like so: In cell A1 type your starting permutation, e.g. "ABCDE" In cell A2 enter =NextPerm(A1) (you should…

Excel VBA to find next permutation or list of permutations

Function NextPerm(ByVal strIndex As String)
    nChanger = FindChanger(strIndex)
    If nChanger = 0 Then
        NextPerm = SortAscending(strIndex)
        Exit Function
    End If
    strNextStart = Left(strIndex, nChanger - 1)
    strNextEnd = StepEndUp(Mid(strIndex, nChanger))
    NextPerm = strNextStart & strNextEnd
End Function
Function FindChanger(ByVal strIndex As String)
    nLen = Len(strIndex)
    For n = nLen To 2 Step -1
        strEndian = Mid(strIndex, n, 1)
        strStartian = Mid(strIndex, n - 1, 1)
        nEndian = Asc(strEndian)
        nStartian = Asc(strStartian)
        If nStartian < nEndian Then FindChanger = n - 1: Exit Function
    Next n
    FindChanger = 0
End Function
Function StepEndUp(ByVal strIndex As String)
    nLen = Len(strIndex)
    nNewMid = 999
    strStartian = Left(strIndex, 1)
    For n = 2 To nLen
        strMidian = Mid(strIndex, n, 1)
        If Asc(strMidian) > Asc(strStartian) And Asc(strMidian) < nNewMid Then
            nNewMid = Asc(strMidian)
        End If
    Next n
    strNewMid = Chr(nNewMid)
    strTempEnd = Application.WorksheetFunction.Substitute(strIndex, strNewMid, "")
    strEnd = SortAscending(strTempEnd)
    StepEndUp = strNewMid & strEnd
End Function
Function SortAscending(ByVal strIndex As String)
    nLen = Len(strIndex)
    nMin = 999
    For n = 1 To nLen
        nMin = Application.WorksheetFunction.Min(nMin, Asc(Mid(strIndex, n, 1)))
    Next n
    strTemp = Chr(nMin)
    strTempEnd = Application.WorksheetFunction.Substitute(strIndex, strTemp, "")
    If Len(strTempEnd) > 1 Then
        SortAscending = strTemp & SortAscending(strTempEnd)
    Else
        SortAscending = strTemp & strTempEnd
    End If
End Function