Two words of 3 letters twice

I came across this word called

LOGLOGS

I need macro to scan dictionary and place such words at c1 downwards

LOGIC , 3 letter word twice in the word , this means LOG was twice in the word

If it pours correctly it will pull BULBULS others i forgot

Find attached

VBA code:

Sub DoubleLetters()
Dim A, T&, TC&, TD&, X&, W$
A = Range("a1").CurrentRegion

With CreateObject("Scripting.dictionary")
For T = 1 To UBound(A, 1)
W = A(T, 1)
 For TC = 1 To Len(W) - 5
    For TD = TC + 3 To Len(W) - 2
    If Mid(W, TC, 3) = Mid(W, TD, 3) Then
    .Add W, T
    GoTo Line1
    End If
    Next TD
 Next TC
Line1:
Next T
    Range("C1").CurrentRegion.Clear
    Range("C1").Resize(.Count, 1) = WorksheetFunction.Transpose(.Keys)
End With
End Sub

Here are solutions with a formula:

Excel 2007 and newer:

Please insert an empty row at the top and try in C2 and copy down (confirm the formula with Ctrl+Shift+Enter; response time after copy down about 20 seconds):

Formula:

=INDEX(A$2:A$34255,MATCH(1,((MID(A$2:A$34255,1,3)=MID(A$2:A$34255,4,3))+(MID(A$2:A$34255,1,3)=MID(A$2:A$34255,5,3))+(MID(A$2:A$34255,2,3)=MID(A$2:A$34255,5,3))>0)*(COUNTIF(C$1:C1,A$2:A$34255)=0),0))

Excel 2021 or 365:

Please try in D2 (no copy down needed; response time within 1 second):

Formula:

FILTER(A2:A34255,(MID(A2:A34255,1,3)=MID(A2:A34255,4,3))+(MID(A2:A34255,1,3)=MID(A2:A34255,5,3))+(MID(A2:A34255,2,3)=MID(A2:A34255,5,3)))

Another ("borrowed" some of KVS code

Option Explicit

Sub FindDoubleLetters()
Dim A, T&, TC&, TD&, X&, W$, n$
Dim xstr As String
A = Range("a1").CurrentRegion
ReDim b(1 To UBound(A, 1))
n = 0
For T = 1 To UBound(A, 1)
W = A(T, 1)
 For TC = 1 To 2
    xstr = Mid(W, TC, 3)
    xstr = Replace(W, xstr, "")
    If Len(xstr) = 1 Then n = n + 1: b(n) = W: Exit For
 Next TC
Next T
    Range("C1").CurrentRegion.Clear
    Range("C1").Resize(n, 1) = Application.Transpose(b)

End Sub

You are Welcome! Thanks for the rep. with kindly rep. comment . Glad to have helped with a formula. .