Ускорить работу программы - VB

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

суть такова, на форме имеется два текст бокса и кнопка, в первый текст бокс вводится набор букв, во второй цифра, которая будет означать количество букв в слове, далее набор букв из первого текст бокса разбивается на отдельные символы и заполняется в массив, после чего из них генерируются слова, так вот этот код работает быстро к примеру на 3-4 символа (как в моем коде, скинутом для примера), вчера поставил генерацию из 12 символов, по 5 букв в слове так он залип на минут 15, мой вопрос таков: можно ли ускорить работу моего кода, или оптимизировать как то, или даже заменить что то, так как я может вообще использую "деревянный метод" так как программированием давно не занимался, и второй под вопрос, можно ли отсеивать не существующие слова сразу, Application.CheckSpelling - пропускает много не нужных слов. пример моего кода на генерацию 3 слова из трех букв:

Dim razmer, schet As Integer
schet = 1
kolbukv = CInt(Text1.Text)
str = Text2.Text
razmer2 = Len(str)
ReDim sim(razmer2)
For i = 1 To Len(Text2)
   sim(i) = Mid$(Text2, i, 1)
  Next i
If kolbukv = 3 Then
 razmer = UBound(sim())
  For i1 = 1 To razmer
   For i2 = 1 To razmer
    For i3 = 1 To razmer
    slovo = sim(i1) & sim(i2) & sim(i3)
      If Application.CheckSpelling(slovo) Then
        Cells(schet, 1) = slovo
        schet = schet + 1
      End If
  Next i3
 Next i2
Next i1

может я плохо объяснил суть вопроса, в общем это генератор слов из заданных букв, буквы вводятся в первый текст бокс, а во второй вводится цифра, означающая количество букв в слове, после чего буквы из первого текст бокса заполняются в массив отдельными символами, а дальше с помощью вложенных циклов эти отдельные элементы массива присоединяются друг к другу во всех возможных комбинациях, и выводятся в ячейку таблицы Excel, я скинул фрагмент кода в котором генерация слова идет из трех букв, можно ли реализовать эту задачу другим способом, так как мой способ затрачивает много времени.

Решение задачи: «Ускорить работу программы»

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

                            Option Explicit
Option Compare Text
Private Sub CommandButton1_Click()
    Dim dic, s As String, i As Long, j As Long, n As Long, k As Long
    Open ThisWorkbook.Path & "\Dictionary.txt" For Input As #1
          dic = Split(Input(LOF(1), #1), vbCrLf)
    Close #1
    n = Val(TextBox1.Text): s = Trim$(TextBox2.Text)
    ThisWorkbook.Sheets(1).Columns("B:B").ClearContents
    For i = 0 To UBound(dic)
       If Len(dic(i)) = n Then
         For j = 1 To Len(dic(i))
            If InStr(1, s, Mid(dic(i), j, 1)) = 0 Then GoTo m
         Next j
         k = k + 1
         Cells(k, 2) = dic(i)
m:     End If
    Next i
End Sub
                        