Search For Double Characters and Place Character In-Between

[Manfred]

Is there a simple way to find all double characters in a string (of variable length) and place another character in-between them? I'm completely stumped!

eg. "MESSAGE" would become "MESXSAGE"

 

[MickG]

Try this for String in "A1"

[COLOR="Navy"]Sub[/COLOR] MG01Dec34
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Temp [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]For[/COLOR] n = 1 To Len([a1])
    [COLOR="Navy"]If[/COLOR] Not IsEmpty(Temp) [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] Mid([a1], n, 1) = Temp [COLOR="Navy"]Then[/COLOR]
            [a1] = Mid([a1], 1, n - 1) & "X" & Mid([a1], n)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
Temp = Mid([a1], n, 1)
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Manfred]

Thanks Mick, that worked great

 

[MickG]

You're welcome

 

[Peter_SSs]

A couple of comments.

Mick, you may want to revisit that code considering A1 might hold "Mississippi" or "Wooloomooloo" (Suburb of Sydney BTW )

Manfred, could the string hold a name (or any word) like "Llewellyn", and if so should it have the "X" between those first two Ls as well as the second two? I ask because Mick's code would also need a tweak for that.

An alternative suggestion. Change the IgnoreCase line to False if you do want the check to be case-sensitive.

Sub SplitDouble()
  With CreateObject("vbScript.RegExp")
    .Global = True
    .IgnoreCase = True
    .Pattern = "(.)\1"
    Range("A1").Value = .Replace(Range("A1").Value, "$1X$1")
  End With
End Sub

 

[pgc01]

Hi

Also are these really names or codes.

If they are codes there can be a sequence of 3, 4 equal characters. In that case what would you like, insert the X after each character? after each 2?

Ex.
AAAA becomes AXAAXA or AXAXAX?

 

[Peter_SSs]

I had wondered about PGCs question too but guessed the strings were normal words.

My previous code would turn "AAAA" into "AXAAXA"

If it should be "AXAXAXA" then just change these two lines of my code.

.Pattern = "(.)(?=\1)"
Range("A1").Value = .Replace(Range("A1").Value, "$1X")

 

[Manfred]

Good points. They are indeed words, however, I had not taken into consideration the fact I need to trim all of the spaces out of the string, thus potentially creating more doubles. Peter, your code takes care of that nicely!

Thanks all

 

[Peter_SSs]

Glad you got something suitable.

For interest, if you (or anyone reading) wanted a non-RegExp solution, then this UDF that could be used in a worksheet as shown below or just within vba might be worth a try.
It gives additional options of what character(s) to place between the repeated characters and whether to check in a case-sensitive manner or not.

Function SplitDoubles(s As String, Delim As String, Optional CheckCase As Boolean = False) As String
  Dim i As Long
  Dim t As String
  
  t = s
  If Not CheckCase Then t = LCase(s)
  For i = Len(t) To 2 Step -1
    If Mid(t, i, 1) = Mid(t, i - 1, 1) Then
      s = Left(s, i - 1) & Delim & Mid(s, i)
    End If
  Next i
  SplitDoubles = s
End Function

Excel Workbook
	A	B	C	D
1	MESSAGE	MESXSAGE	MES SAGE	MES:-:SAGE
2	Cat	Cat	Cat	Cat
3	Mississippi	MisXsisXsipXpi	Mis sis sip pi	Mis:-:sis:-:sip:-:pi
4	AaAaA	AXaXAXaXA	AaAaA	A:-:a:-:A:-:a:-:A
5	Llewellyn	LXlewelXlyn	Llewel lyn	L:-:lewel:-:lyn
Sheet2

 

[Manfred]

I've just tried that out - really nice! I'm still learning at the moment, I'm quite a long way off being able to write my own UDFs, but hopefully I'll get there one day!