VBA Express : Excel - Remove or Reduce Internal Blanks In A String

Excel

Remove or Reduce Internal Blanks In A String

Ease of Use

Easy

Version tested with

2003

Submitted by:

Cyberdude

Description:

A function that will reduce the number of blanks separating other characters in a string to a specified maximum or will remove them entirely. It will optionally remove leading and trailing blanks.

Discussion:

The function ?IntTrim? is similar to the function ?Trim? and will do what it does, i.e., it removes the leading and trailing blanks from a string. It will also remove all internal blanks from the string or reduce the number of blanks separating characters to any specified number. It will not increase the separating blanks to the specified number. If you specify a maximum of two blanks separating any two characters and the string has a single blank separating two characters, it wil not be increased to two. I recommend that you make the macro resident in your ?Personal.xls? workbook so it can be found easily by macros in any of your other workbooks. In addition to the function ?IntTrim?, I have included the macro ?IntTrim_Locator? which can be used to test the function, and will help you find the function in the macro name list. The attached demonstration workbook ?Internal Trim Demo.xls? contains details of the function syntax, a description of the three optional arguments, and several examples of typical applications.

Code:

instructions for use

			 '~~~~~~~~~~~ CODE FOR TESTING FUNCTION "IntTrim" ~~~~~~~~~~~~~~~
Sub IntTrim_Locator() 
    Dim Temp$, Msg$, K% 
     'Note: In the following demonstration statements the fourth argument ("True")
     '   is used to display the results of the statement after it executes.   Normally
     '   this argument should NOT be specified in production use.
     
     'Instructions for test:   Left click anywhere on this macro code, then press F5.
Test1: 
     'Remove leading & trailing blanks; reduce all internal blanks to one.
    Temp = IntTrim("     A        B     ", , , True) '(Outputs the string "A B")
     'Remove leading & trailing blanks; reduce all internal blanks to two.
Test2: 
    Temp = IntTrim("A      B       C", 2, , True) '(Outputs the string "A  B  C")
     'Keep leading & trailing blanks; reduce all internal blanks to one.
Test3: 
    Temp = IntTrim("   A      B       C   ", , False, True) '(Outputs the string "   A B C   ")
     'Remove leading & trailing blanks; remove all internal blanks.
Test4: 
    Temp = IntTrim("   A      B       C  ", 0, , True) '(Outputs the string "ABC")
End Sub 
 
 '~~~~~~~~~~~~~~~ CODE FOR FUNCTION "IntTrim" ~~~~~~~~~~~~~~~~~~~  9/16/05
Function IntTrim(InputString As String, _ 
    Optional MaxBlanks As Integer = 1, _ 
    Optional RemvLeadTrail As Boolean = True, _ 
    Optional Test As Boolean = False) As String 
    Dim N As Integer, LenInputString As Integer, LenIntTrim As Integer 
    Dim LeadingBlankCnt As Integer, TestCnt As Integer 
    Dim Msg As String, DisplayVal As String 
    Const Title$ = "Function 'IntTrim'" 
    LenInputString = Len(InputString) 
    On Error GoTo ErrorReturn 
     'Replace Chr(160) type blanks (if any) with standard blanks
    IntTrim = Replace(InputString, Chr(160), Chr(32)) 
    IntTrim = Trim(IntTrim) 
    LenIntTrim = Len(IntTrim) 
    Do Until InStr(1, IntTrim, Space(MaxBlanks + 1)) = 0 
        IntTrim = Replace(IntTrim, Space(MaxBlanks + 1), Space(MaxBlanks)) 
    Loop 
     'Does caller want leading and trailing blanks removed?
    If Not RemvLeadTrail _ 
    Then 
        LeadingBlankCnt = InStr(1, InputString, Left(Replace(InputString, " ", ""), 1)) - 1 
        IntTrim = Space(LeadingBlankCnt) & IntTrim & Space(Len(InputString) - LeadingBlankCnt - LenIntTrim) 
    End If 
     'Is this executing in "test" mode?
    If Test _ 
    Then 
        DisplayVal = IntTrim 
        For N = 1 To Len(IntTrim) 
            InputString = Replace(InputString, " ", ".") 
            InputString = Replace(InputString, Chr(160), ".") 
            DisplayVal = Replace(DisplayVal, " ", ".") 
            DisplayVal = Replace(DisplayVal, Chr(160), ".") 
        Next N 
        Msg = "Input string:    '" & InputString & "'" & vbCr & _ 
        "Output string: '" & DisplayVal & "'" & vbCr & vbCr & _ 
        "Options" & vbCr & _ 
        "   MaxBlanks (internal):  " & MaxBlanks & vbCr & _ 
        "   RemvLeadTrail:           " & RemvLeadTrail & vbCr & _ 
        "   Test (mode):                 True" 
        MsgBox Msg, , Title 
    End If 
    GoTo Finish 
ErrorReturn: 
    IntTrim = CInt(CVErr(xlErrValue)) 
Finish: 
    On Error GoTo 0 
End Function

How to use:

Copy the code above.
Press Alt+F11 to view the VBE window.
Select the VBA project (or Personal.xls) for the workbook where you want the macros to be resident.
Select INSERT -> MODULE.
Paste the code into the module window.
Press Alt+F4 to close the VBE window.

Test the code:

Open the attached workbook ?Internal Trim Demo.xls?.
Press Alt+F11 to view the VBE window.
In the macro ?IntTrim_Locator?, run a test demonstration by left clicking anywhere within the macro, then press PF5.
Next, make the first example statement in the header area a comment, then uncomment the second example statement.
Click on the macro and press PF5. You should see the original string and the modified string displayed by Msgbox.
Next, make the second example statement a comment, then uncomment the third example statement.
Click on the macro and press PF5. You should see the original string and the modified string displayed by Msgbox.
In similar fashion, run the remaining demonstration statements.

Sample File:

Internal Trim Demo.zip 20.55KB

Approved by mdmackillop

This entry has been viewed 154 times.