Porgramme to Solve the words in a set of jumbled Alphabets

Public myWords() As String
Public wordCount As Integer
Public xx As Long
Public expString As Words
Public scrambDict As New Scripting.Dictionary
Public Sub myTrainedScript()

Dim word As String
Dim strcombis As String
Dim l, pos, c
Dim myStrs() As String * 1
Dim wordLen As Integer
Dim mlen, posx
Dim loopWord
xx = 0

wordCount = 0
ReDim myWords(wordCount) As String


word = InputBox("Please give me letters", "Ask Letters")
word = sortStr(word)
wordLen = Len(word)
ReDim myStrs(wordLen) As String * 1

For l = 1 To wordLen
  myStrs(l) = Mid(word, l, 1)
Next
strCombi word
elimOnePos word, 3
scrambDict.RemoveAll

Debug.Print xx

wordCount = UBound(myWords)

If wordCount = 0 Then Exit Sub

For i = 1 To wordCount
  For j = i + 1 To wordCount
  If myWords(i) > myWords(j) Then
    temp = myWords(i)
    myWords(i) = myWords(j)
    myWords(j) = temp
  End If
 Next
Next

For i = 1 To wordCount
  For j = i + 1 To wordCount
    If Len(myWords(i)) > Len(myWords(j)) Then
      temp = myWords(i)
      myWords(i) = myWords(j)
      myWords(j) = temp
    End If
  Next
Next

mylen = Len(myWords(1))

For i = 1 To wordCount
  If myWords(i) <> myWords(i - 1) Then
  If Len(myWords(i)) = mylen Then
    ActiveDocument.Range.InsertAfter myWords(i) & ", "
  Else
  ActiveDocument.Range.InsertAfter Chr(13)
  ActiveDocument.Range.InsertAfter myWords(i) & ", "
  mylen = Len(myWords(i))
 End If
End If
Next
End Sub
Public Sub elimOnePos(srcStr, tgtLen)
Dim thisLen As Integer, thisLoopStr As String
thisLen = Len(srcStr)
For i = 1 To thisLen
 Select Case i
  Case 1
    thisLoopStr = Right(srcStr, thisLen - 1)
  Case thisLen
    thisLoopStr = Left(srcStr, thisLen - 1)
  Case Else
    thisLoopStr = Mid(srcStr, 1, i - 1) & Mid(srcStr, i + 1, thisLen - i)
  End Select
  thisLoopStr = sortStr(thisLoopStr)
  If Not (scrambDict.Exists(thisLoopStr)) Then
  scrambDict.Add thisLoopStr, thisLoopStr
  strCombi thisLoopStr
  If Len(thisLoopStr) <> tgtLen Then
  elimOnePos thisLoopStr, tgtLen
  End If
  End If
  xx = xx + 1
Next
End Sub


Sub strCombi(inputString As String) ' main program structure begins here
Dim seedinput As String * 1
Dim remainstrX As String
Dim chkchar As String * 1
Dim stringLength As Integer, i As Integer
Dim strs() As String * 1
stringLength = Len(inputString)
ReDim strs(stringLength) As String * 1
inputString = sortStr(inputString)
seedinput = ""
For i = 1 To stringLength
  strs(i) = Mid(inputString, i, 1)
Next
For i = 1 To stringLength
  If (strs(i) <> seedinput) Then
  seedinput = strs(i)
  Select Case i
  Case 1
  remainstrX = Right(inputString, stringLength - 1)
  Case stringLength
  remainstrX = Left(inputString, stringLength - 1)
  Case Else
  remainstrX = Mid(inputString, 1, i - 1) & Mid(inputString, i + 1, stringLength - i)
 End Select
  Call StrRecur(seedinput, Trim(remainstrX), 0, "@")
  End If
Next
End Sub


Sub StrRecur(instrX, mainstrX, cplace, cchar) ' this is a recursive subsroutine
Dim chklen As Integer, i As Integer
Dim seedStr As String, nxtstr As String
Dim nxtchar
Dim strsX() As String * 1


chklen = Len(mainstrX)
If (chklen = 1) Then
  seedStr = instrX & mainstrX
  GoTo myt20
End If
nxtchar = ""
ReDim strsX(chklen) As String * 1
For i = 1 To chklen
  strsX(i) = Mid(mainstrX, i, 1)
Next

For i = 1 To chklen
  If (nxtchar <> strsX(i)) Then
  nxtchar = strsX(i)
  seedStr = instrX & nxtchar
  Select Case i
  Case 1
  nxtstr = Mid(mainstrX, i + 1, chklen - i)
  Case chklen
  nxtstr = Mid(mainstrX, 1, i - 1)
  Case Else
  nxtstr = Mid(mainstrX, 1, i - 1) & Mid(mainstrX, i + 1, chklen - i)
 End Select
  Call StrRecur(Trim(seedStr), Trim(nxtstr), cplace, cchar)
  End If
Next
GoTo myt30
myt20: If (cplace <> 0) Then
  If (Mid(seedStr, cplace1) = cchar) Then
  If Application.CheckSpelling(seedStr) Then
  ActiveDocument.Paragraphs.Add (seedStr)
  End If
End If
  Else
  If Application.CheckSpelling(seedStr) Then
  wordCount = wordCount + 1
  ReDim Preserve myWords(wordCount) As String
  myWords(wordCount) = seedStr
  End If
 End If
myt30: xxd = 0
End Sub

Function sortStr(instrX) As String
Dim temp As String * 1
Dim strLen As Integer
Dim strs() As String * 1

strLen = Len(instrX)
ReDim strs(strLen) As String * 1

For i = 1 To strLen
  strs(i) = Mid(instrX, i, 1)
Next

For i = 1 To strLen - 1
  For j = (i + 1) To strLen
  If (strs(i) > strs(j)) Then
 temp = strs(i)
  strs(i) = strs(j)
  strs(j) = temp
  End If
  Next
Next

sortStr = ""

For i = 1 To strLen
 sortStr = sortStr & strs(i)
Next

End Function