¿Eliminating repeat characters? 2

[crrrazydan]

What I want to do is eliminate all repeat characters in a text box. Like if in Text1.Text it said 'EXXAMMMMPLLE TEXXXTT' I want to make it say 'EXAMPLE TEXT'. I suspect the Mid$ function would be used. How could I do this?

 

[TheInsider]

Why would you want to do this? For example, if someone typed in "Access", you would return "Aces"? Well, one thing to note is that you have to be specific on where and how to remove duplicates or else "Example Text" will become "Exampl T". Rob Marriott
robert_a_marriott@yahoo.com

Hire me! Full-time, contract, whatever...shhh don't let my current employer know I said that.

 

[crrrazydan]

I want it to remove repeat letters that are right next to each other. So 'RREMMOVVVVE' would be 'REMOVE' --the letters RR would be R and VVVV would be V. I want to take the individual letters, one by one, and see if the letter before it is the same. So yes, I suppose Access would be Aces.

 

[elziko]

Pass this function your text string and it will return what you wish. Time I gave something back I figured.

Its probably not the most efficient, but it works!

Public Function DelRepChar(Text As String)
Dim TextLength, TextPosition, RepPoint, Count As Integer
TextLength = Len(Text)
TextPosition = 1
Count = 0
Do Until TextPosition = TextLength - Count
If Mid(Text, TextPosition, 1) = Mid(Text, TextPosition + 1, 1) Then
RepPoint = TextPosition
Text = Left(Text, TextPosition) + Mid(Text, TextPosition + 2)
TextPosition = TextPosition - 1
Count = Count + 1
End If
TextPosition = TextPosition + 1
Loop
DelRepChar = Text
End Function

 

[crrrazydan]

Thanks Elziko, the code works great!

 

[elziko]

Glad. And I wrote it just for you! Felt guilty for always taking and never giving

 

[Snaggs]

Just for fun, I wanted to see how else the function could be written. The first attempt I made was to use as few lines as possible to write the code. The second attempt was to write the function recursively. Granted the least amount of code version is not very maintenance friendly and the recursive one is most definitely the poorest performer.

Here's what I came up with.

Private Function StripIt(strText As String) As String
Dim intOffset As Integer

For intOffset = 1 To Len(strText)
StripIt = StripIt & IIf(Mid$(strText, intOffset, 1) = Mid$(strText, intOffset + 1, 1), _
"", Mid$(strText, intOffset, 1))
Next intOffset
End Function

Private Function StripItRec(strText As String) As String
Dim strReturnString As String

If Len(strText) = 1 Then
StripItRec = strText
Else
strReturnString = StripItRec(Mid$(strText, 2))
StripItRec = IIf(Left$(strReturnString, 1) = Left$(strText, 1), _
strReturnString, _
Left$(strText, 1) & strReturnString)
End If
End Function
Snaggs
tribesaddict@swbell.net

 

[crrrazydan]

Hey! Also, I was kind of wondering how you would delete the last letter in a textbox. Like if you clicked command1 (so not just pressing backspace) it would take off the last letter.

 

[dpaulson]

text1 = left$(text1,len(text1-1))
David Paulson