Hi guys,

Could you help me with this?

Basically what I need is:

If I have the letters "abc": It would give me: "abc", "acb", "cab", "cba", "bac", "bca".

The programme I have is only giving me "abc".

Can you please help me?

Private Sub CommandButton1_Click()

Range("A1", Columns("A").SpecialCells(xlCellTypeLastCell)).Delete

Dim Letters As String
    Dim WriteMe As String
    Dim ChooseThese() As Boolean
    Dim HowMany As Long
    Dim i As Long, EndNow As Boolean
    
    Letters = "abc"
    HowMany = 3
    
    ReDim ChooseThese(1 To Len(Letters))
    For i = 1 To HowMany
        ChooseThese(i) = True
    Next i
    
    Do
        For i = 1 To Len(Letters)
            If ChooseThese(i) Then
                Sheet1.Cells(1 + j, 1) = Sheet1.Cells(1 + j, 1) & Mid(Letters, i, 1)
            End If
        Next i
        j = j + 1
        ChooseThese = NextChoices(ChooseThese, EndNow)
    Loop Until EndNow
    
End Sub


Function NextChoices(ByVal arrChoices As Variant, Optional ByRef Overflow As Boolean) As Variant
    Dim Pointer As Long, outPoint As Long
    
    Overflow = True
    
    Pointer = LBound(arrChoices)
    
    Do Until arrChoices(Pointer)
        Pointer = Pointer + 1
    Loop
    outPoint = LBound(arrChoices) - 1
    Do
        If arrChoices(Pointer) Then
            outPoint = outPoint + 1
            arrChoices(Pointer) = False
            arrChoices(outPoint) = True
            Pointer = Pointer + 1
        Else
            arrChoices(outPoint) = False
            arrChoices(Pointer) = True
            Overflow = False
            Exit Do
        End If
    Loop Until UBound(arrChoices) < Pointer
    
    NextChoices = arrChoices
    
End Function