AJP Excel Information

The Excel Word Challenge routines

Function TestWord(Text As String, Wide As Integer) As Boolean
   intPos = 1
   Do While intPos < Len(Text)
      If Mid(Text, intPos, Wide) < Mid(Text, intPos + Wide, Wide) Then
         ' current letters and less than next
         intPos = intPos + Wide
      ElseIf (intPos + Wide) > Len(Text) Then
         TestWord = (Mid(Text, intPos, Wide) <= "IV")
         Exit Function
      Else
         Wide = Wide + 1
         If Wide > 2 Then Exit Function
         'enough to do doubles
         If ((Len(Text) - (intPos + Wide - 1)) Mod 2) = 0 Then
            TestWord = TestWord(Mid(Text, intPos), Wide)
         Else
            TestWord = TestWord(Mid(Text, intPos + 1), Wide)
         End If
         Exit Function
      End If
   Loop
   TestWord = True
End Function

Function TestWordRev(Text As String, Wide As Integer) As Boolean
   intPos = Len(Text) - Wide + 1
   Do While intPos > 0
      If (intPos - Wide) < 1 Then
         If Wide = 1 Then
            TestWordRev = (Mid(Text, intPos, Wide) <= "Z")
         Else
            TestWordRev = (Mid(Text, intPos, Wide) <= "IV")
         End If
         Exit Function
      ElseIf Mid(Text, intPos - Wide, Wide) > Mid(Text, intPos, Wide) Then
         ' current letters and less than next
         intPos = intPos - Wide
      Else
         Wide = Wide + 1
         If Wide > 2 Then Exit Function
         'enough to do doubles
         If (intPos Mod 2) = 0 Then
            TestWordRev = TestWordRev(Left(Text, intPos), Wide)
         Else
            TestWordRev = TestWordRev(Left(Text, intPos - 1), Wide)
         End If
         Exit Function
      End If
   Loop
   TestWordRev = True
End Function

To use the routines try this test

Sub TestWords()
   Dim strTest As String
   strTest = "AEGILOPS"
   If (TestWord(strTest, 1) Or TestWordRev(strTest, 1)) Then
      MsgBox strTest & " Can be used"
   Else
      MsgBox strTest & " Can not be used"
   End If
End Sub