View Single Post
  #17  
Old April 15th, 2009, 01:16 AM posted to microsoft.public.excel.worksheet.functions
Bernie Deitrick
external usenet poster
 
Posts: 2,496
Default Macro for detect palindromes and repeats in letters/numbers string

Luciano,

Change the code to that given below to include the count of the number of
repeats, then select A2:B??? before entering =PALINDROMES(A1) using
Ctrl-Shift-Enter.

HTH,
Bernie
MS Excel MVP

Function Palindromes(strBig As String) As Variant
Dim FoundPals() As String
Dim PalCount As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim PalExists As Boolean

PalCount = 1
ReDim FoundPals(1 To 2, 1 To 2)
For i = 1 To Len(strBig) - 1
For j = 2 To Len(strBig) - i + 1
If isPal(Mid(strBig, i, j)) Then
If PalCount = 1 Then
FoundPals(1, 2) = Mid(strBig, i, j)
FoundPals(2, 2) = 1
PalCount = 2
Else
PalExists = False
For k = 2 To UBound(FoundPals, 2)
If FoundPals(1, k) = Mid(strBig, i, j) Then
PalExists = True
FoundPals(2, k) = FoundPals(2, k) + 1
End If
Next k
If Not PalExists Then
ReDim Preserve FoundPals(1 To 2, 1 To PalCount + 1)
FoundPals(1, PalCount + 1) = Mid(strBig, i, j)
FoundPals(2, PalCount + 1) = 1
PalCount = PalCount + 1
End If
End If
End If
Next j
Next i

FoundPals(1, 1) = "Palindromes found:"
FoundPals(2, 1) = PalCount - 1
Palindromes = Application.Transpose(FoundPals)

End Function
Function isPal(strPal As String) As Boolean
Dim i As Integer
Dim strTemp As String
isPal = False
For i = Len(strPal) To 1 Step -1
strTemp = strTemp & Mid(strPal, i, 1)
Next i
isPal = (strPal = strTemp)
End Function



"Luciano Paulino da Silva" wrote in message
...
Bernie,
Yes, it is working fine. Thank you very much.
During some situations it is very slow, but I understand that there
are a lot of possibilities to test.
Do you know how some code could be used to check about repeats using
the same strategy?
Thanks in advance,
Luciano