Luciano,
Same drill: Enter
=REPEATS(A1) into cells A2:B??? using Ctrl-Shift-Enter.
HTH,
Bernie
MS Excel MVP
Option Explicit
Function Repeats(strBig As String) As Variant
Dim FoundRpts() As String
Dim RptCount As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim x As Integer
Dim RptExists As Boolean
RptCount = 1
ReDim FoundRpts(1 To 2, 1 To 2)
For i = 1 To Len(strBig) - 1
For j = 2 To Len(strBig) - i + 1
x = isRpt(Mid(strBig, i, j), strBig, i + 1)
If x > 0 Then
If RptCount = 1 Then
FoundRpts(1, 2) = Mid(strBig, i, j)
FoundRpts(2, 2) = x
RptCount = 2
Else
RptExists = False
For k = 2 To UBound(FoundRpts, 2)
If FoundRpts(1, k) = Mid(strBig, i, j) Then
RptExists = True
End If
Next k
If Not RptExists Then
ReDim Preserve FoundRpts(1 To 2, 1 To RptCount + 1)
FoundRpts(1, RptCount + 1) = Mid(strBig, i, j)
FoundRpts(2, RptCount + 1) = x
MsgBox FoundRpts(1, RptCount + 1) & " " & x
RptCount = RptCount + 1
End If
End If
End If
Next j
Next i
FoundRpts(1, 1) = "Repeats found:"
FoundRpts(2, 1) = RptCount - 1
Repeats = Application.Transpose(FoundRpts)
End Function
Function isRpt(strRpt As String, strPar As String, i As Integer) As Integer
isRpt = 0
If InStr(i, strPar, strRpt) > 0 Then
isRpt = (Len(Mid(strPar, i, Len(strPar))) - _
Len(Replace(Mid(strPar, i, Len(strPar)), strRpt, ""))) / _
Len(strRpt) + 1
End If
End Function
