Compress spaces in a string

[nandagopal]

Code Select Expand

Private Function PreventDuplicateSpaces(Word)
    Dim i, WordLength, Character, LastCharacter, NewWord

    On Error GoTo ErrorHandler
    WordLength = Len(Word)
    For i = 1 To WordLength
        Character = Mid(Word, i, 1)
        If LastCharacter = " " And Character = " " Then
        Else
            NewWord = NewWord & Character
            LastCharacter = Character
        End If
    Next i

    PreventDuplicateSpaces = Trim(NewWord)
    Exit Function

ErrorHandler:
    ' Insert your favorite error handler here.
End Function


Steve Okonski offers this version which is about 50 times faster.


Function fastremoveduplicatespaces$ (txt$)
Dim localtxt$, pt%

    localtxt$ = Trim$(txt$)
    Do
        pt% = InStr(localtxt$, " ") ' 2 blank spaces
        If pt% = 0 Then Exit Do
        localtxt$ = Left$(localtxt$, pt%) + _
            Trim$(Mid$(localtxt$, pt%))
    Loop
    fastremoveduplicatespaces$ = localtxt$
End Function


If you are using Visual Basic 6, you can use the Replace statement to produce the following simpler function that has about the same performance.


Private Function CompressSpaces(ByVal txt As String) As _
    String
    Do While InStr(txt, "  ") > 0
        txt = Replace(txt, "  ", " ")
    Loop
    CompressSpaces = txt
End Function