Мутация строчных/заглавных - VBA

Формулировка задачи:

Доброго времнени дня. Застрял, хочу понять как сделать чтоб: Имеем какое-нибудь текстовое значение, пусть будет ABCDE. Хотим получить список всех возможных написаний используя заглавные и строчные буквы. Соответственно abcde abcdE abcDe abcDE abCde abCdE abCDe abCDE aBcde aBcdE aBcDe ... и так далее. Поигрался, сделал код, который кое как для 5-ти символов рожает что нужно, но во первых выглядит страшно, во вторых не арбайтен на больше 5-ти символо. Похоже сам подход неверный, что в этом случае сделать лучше?

sub test()
 
i = 1
k = 1
dep = 0
kk = 0
 
Сells(k, 6) = "abcde"
slovo = Cells(k, 6)
k = k + 1
    
    Do While Cells(k - 1, 6) <> UCase(Cells(k - 1, 6))
        
        For j = 0 To Len(Cells(k - 1, 6))
            If Mid(Cells(k - 1, 6), j + 1, 1) = UCase(Mid(Cells(k - 1, 6), j + 1, 1)) Then
                Exit For
            End If
        Next
 
        If j < Len(slovo) Then
            Cells(k, 6) = zag(j, Cells(k - 1, 6))
            j = j + 1
            Cells(k, 6) = Left(Cells(k, 6), j - 1) & LCase(Right(Cells(k, 6), Len(slovo) - j + 1))
            k = k + 1
        End If
 
        Do While j <= Len(slovo)
            'Cells(k, 6) = zag(j, Cells(k - 1, 6))
            If j < Len(slovo) Then
                Call jopa(j + 1, slovo)
                'If kk <> 0 Then j = j + 1
                If kk > 1 Then kk = kk + 1
                Cells(k, 6) = zag(j, Cells(k - 1 - kk, 6))
            Else
                If zag(j, Cells(k - 1, 6)) = Cells(k - 1, 6) Then
                    k = k - 1
                Else
                    Cells(k, 6) = zag(j, Cells(k - 1, 6))
                End If
            End If
            
            k = k + 1
        j = j + 1
        kk = 0
        Loop
        
    Loop
 
End Sub
 
Sub jopa(j, slovo)
 
'If kk <> 0 Then kk = kk + 1
onetime = True
 
Do While j <= Len(slovo)
    If j < Len(slovo) Then
        Call jopa(j + 1, slovo)
    End If
    If j = Len(slovo) Then
        Cells(k, 6) = zag(j, Cells(k - 1, 6))
        If zag(j, Cells(k - 1, 6)) = Cells(k - 1, 6) Then
            k = k - 1
        End If
    Else
        If kk = 4 Or kk = 11 Then
            Cells(k, 6) = zag(j, Cells(k - 1, 6))
        ElseIf kk = 9 Then
            kk = kk + 1
            Cells(k, 6) = zag(j, Cells(k - 1 - kk, 6))
        ElseIf kk > 1 And onetime Then
            kk = kk + 1
            onetime = False
            Cells(k, 6) = zag(j, Cells(k - 1 - kk, 6))
        Else
            Cells(k, 6) = zag(j, Cells(k - 1 - kk, 6))
        End If
        
    End If
    k = k + 1
j = j + 1
Loop
 
e = 0
kk = kk + 1
'If kk = 0 Then kk = kk + 1
End Sub
 
Function zag(i, slovo)
 
Dim arr(30)
 
'Cells(k - 1, 6) = ""
For j = 0 To Len(slovo) - 1
    If j + 1 = i Then
        arr(j) = UCase(Mid(slovo, j + 1, 1))
    Else
        arr(j) = Mid(slovo, j + 1, 1)
    End If
Next
 
s = ""
For j = 0 To Len(slovo)
    s = s & arr(j)
Next
 
zag = s
 
End Function

Решение задачи: «Мутация строчных/заглавных»

textual
                            Листинг программы 
                        

                            s = "abcdef"
Do
  Debug.Print s
  For i = Len(s) To 1 Step -1
    If Mid$(s, i, 1) = LCase(Mid$(s, i, 1)) Then
      Mid$(s, i) = StrConv(Mid$(s, i), 3)
      Exit For
    End If
  Next i
Loop While i
                        