Option Explicit
Function Normalize(ByVal strPhrase As String) As String
Dim intLCV As Integer
Dim strNewPhrase As String
strPhrase = LCase(strPhrase)
For intLCV = 1 To Len(strPhrase)
If Mid(strPhrase, intLCV, 1) Like "[a-z]" Then
strNewPhrase = strNewPhrase & Mid(strPhrase, intLCV, 1)
End If
Next intLCV
Normalize = strNewPhrase
End Function
Function IsPalindrome(ByVal strPhrase As String) As Boolean
Dim intBegin As Integer
Dim intEnd As Integer
Dim blnPalindrome As Boolean
intBegin = 1
intEnd = Len(strPhrase)
blnPalindrome = True
Do While intBegin < Len(strPhrase) \ 2 And blnPalindrome = True
If Mid(strPhrase, intBegin, 1) <> Mid(strPhrase, intEnd, 1) Then
blnPalindrome = False
Else
intBegin = intBegin + 1
intEnd = intEnd - 1
End If
Loop
IsPalindrome = blnPalindrome
End Function
Sub FindPalindromes(ByVal strPhrase As String, ByRef strArray() As String)
Dim intLCV As Integer
Dim intPos As Integer
strPhrase = Normalize(strPhrase)
For intLCV = 2 To Len(strPhrase)
intPos = 1
Do While intPos + intLCV <= Len(strPhrase)
If IsPalindrome(Mid(strPhrase, intPos, intLCV)) Then
ReDim Preserve strArray(intLCV)
strArray(intLCV) = Mid(strPhrase, intPos, intLCV)
End If
intPos = intPos + 1
Loop
Next intLCV
End Sub
Private Sub Form_Load()
Dim strPalindromes() As String
Dim intLCV As Integer
Call FindPalindromes("Hello Madam, I'm Adam and this is my friend Bob", strPalindromes)
For intLCV = LBound(strPalindromes) To UBound(strPalindromes)
MsgBox strPalindromes(intLCV)
Next intLCV
End Sub