• Home
 · 
• String Manipulation
 · 
• Replacement for Trim, BuildArray ( builds and returns an array ), Replace/Remove Chars, Proper Case

Replacement for Trim, BuildArray ( builds and returns an array ), Replace/Remove Chars, Proper Case

Replacement for Trim, BuildArray ( builds and returns an array ), Replace/Remove Chars, Proper Case, StripCrLf

API Declarations


Public Enum Trim_Type
LEADING
TRAILING
BOTH
End Enum

Public Enum YESNO
YES = 1
NO = 0
End Enum



Rate Replacement for Trim, BuildArray ( builds and returns an array ), Replace/Remove Chars, Proper Case

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

'********************************************************************
'Trim: Replacement for built in Trim
'
'Input:
'   vData           - Input string
'   TrimAction      - (LEADING,TRAILING,BOTH)
'   TrimChar        - Char to trim      *Optional Default is a Space
'   CaseSensitive   - YES/ON Case Trim  *Optional Default is YES
'
'Result:
'   Trim("009832326",LEADING,"0")   Returns - 9832326
'   Trim("  Hello",LEADING)         Returns - "Hello"
'   Trim("  Hello",LEADING,,NO)     Returns - "hello"
'   Trim("  Hello  ",TRAILING)      Returns - "  Hello"
'   Trim("  Hello  ",BOTH)          Returns - "Hello"
'********************************************************************
    Dim pos As Long, Count As Long, bDoLeft As Boolean, rData As String
    Dim bDoRight As Boolean
    If Len(vData) = 0 Or Len(TrimChar) <> 1 Then TrimChar = "ERROR": Exit Function
    If CaseSensitive = NO Then vData = LCase(vData): TrimChar = LCase(TrimChar)
DoAction:
    Select Case TrimAction
        Case LEADING
            bDoLeft = False
            Do While InStr(1, vData, TrimChar) = 1
                vData = Mid(vData, 2)
            Loop
        Case TRAILING
            bDoRight = False
            Do While InStrRev(vData, TrimChar) = Len(vData)
                vData = Mid(vData, 1, Len(vData) - 1)
            Loop
        Case BOTH
            bDoLeft = True
            bDoRight = True
    End Select
     ' This is where both is really done
    If bDoLeft = True Then
        TrimAction = LEADING
        GoTo DoAction
    End If
    If bDoRight = True Then
        TrimAction = TRAILING
        GoTo DoAction
    End If
    
    Trim = vData
End Function

Public Function ReplaceChars(vData As String, rmvChar As String, Optional rplChar As String = "") As String
'********************************************************************
'ReplaceChars
'
'Inputs:
'   vData       - String
'   rmvChar     - Char(s) to remove
'   rplChar     - Replace rmvChar with these *Optional
'
'Results:
'   ReplaceChars("Hello Everyone","e")      Returns - "Hllo Evryon"
'   ReplaceChars("Hello Everyone","e","4")  Returns - "H4llo Ev4ryon4"
'********************************************************************

    Dim pos As Long, First As String, Last As String
    Do While 1
        pos = InStr(1, vData, rmvChar, vbTextCompare)
        If pos = 0 Then Exit Do
        First = Mid(vData, 1, pos - 1)
        Last = Mid(vData, pos + Len(rmvChar))
        vData = First & rplChar & Last
    Loop
    ReplaceChars = vData
End Function

Public Function BuildArray(vData As String, SectionDelimit As String, Optional FieldDelimit As String) As Variant
'**********************************************************************
' BuildArray:
' (REQUIRED) Part One
'       vData is a delimited string
'       SectionDelimit is the delimiting string
'   Returns - An array of the delimited string.
'             ret(0) is the total number of records.
'
'  (Optional) Part Two
'       FieldDelimit is a second delimiter for each record
'   Returns - An array of the delimited string.
'             ret(0,0) is the total number of records.
'             ret(1,n) is Field name
'             ret(2,n) is Parameter name
'             Where 'n' is the record number.
'
'  Example:
'       Dim aCmd as Variant, STR as New cString, strCmd As String, SP as String
'       SP = " "
'       strCmd = "The Brown Fox Jumped Over The Lazy Dog."
'       aCmd = STR.BuildArray(strCmd,SP)
'       For i = 1 to aCmd(0)    'aCmd(0) = 8
'           Debug.Print aCmd(i) 'Prints each word
'       Next i
'       set aCmd = nothing
'
'Example2:
'       Dim aCmd As Variant, STR As New cString, strCmd As String, SP As String
'       SP = " "
'       strCmd = "FILE=readme.txt DebugFlags=Y RUN=notepad.exe"
'       aCmd = STR.BuildArray(strCmd, SP, "=")
'       For i = 1 To aCmd(0, 0)    'aCmd(0,0) = 3
'           Debug.Print aCmd(1, i) 'File and DebugFlags and RUN
'           Debug.Print aCmd(2, i) 'readme.txt and Y notepad.exe
'       Next i
'       Set aCmd = Nothing
'**********************************************************************
    Dim ret() As Variant, Count As Long, pos As Long, Field As String, Param As String
    Dim bFieldDel As Boolean
    If Not FieldDelimit = "" Then
        bFieldDel = True
        ReDim ret(2, 0): ret(0, 0) = 0
    Else
        ReDim ret(0): ret(0) = 0
    End If
    If Len(vData) = 0 Then GoTo ReturnData
    vData = Trim(vData, BOTH, , YES)
    Do While Not vData = ""
        Count = Count + 1
        pos = InStr(1, vData, SectionDelimit)
        If bFieldDel Then
            ReDim Preserve ret(2, Count)
            ret(0, 0) = Count
        Else
            ReDim Preserve ret(Count)
            ret(0) = Count
        End If
        
        If pos = 0 Then
            If bFieldDel Then
                ret(0, Count) = vData
            Else
                ret(Count) = vData
            End If
            vData = ""
        Else
            If bFieldDel Then
                ret(0, Count) = Mid(vData, 1, pos - 1)
            Else
                ret(Count) = Mid(vData, 1, pos - 1)
            End If
            vData = Mid(vData, pos + Len(SectionDelimit))
        End If
    Loop
    
ReturnData:
    If bFieldDel Then
        For i = 1 To ret(0, 0)
            pos1 = InStr(1, ret(0, i), FieldDelimit)
            If Not pos1 = 0 Then
                Field = Mid(ret(0, i), 1, pos1 - 1)
                Param = Mid(ret(0, i), pos1 + 1)
                ret(1, i) = Field
                ret(2, i) = Param
                ret(0, i) = ""
            End If
        Next i
    End If
    BuildArray = ret()
End Function

Public Function ProperCase(vData As String) As String
'********************************************************************
'ProperCase
'
'Input:
'   vData       String
'
'Returns:
'   ProperCase("hello world")       Returns - "Hello World"
'********************************************************************
    Dim ret() As Variant, retc As String
    ret = BuildArray(vData, " ")
    For i = 1 To ret(0)
        If Not Left(ret(i), 1) = " " Then retc = retc & UCase(Left(ret(i), 1)) & Right(ret(i), Len(ret(i)) - 1) & " "
    Next i
    retc = Trim(retc, trRIGHT, " ", YES)
    ProperCase = retc
End Function

Public Function StripCrLf(vData As String) As String
'********************************************************************
'StripCrLf:
'
'Inputs:
'   vData   String
'
'Results:
'   StripCrLf("Hello" & vbCrlf)     Returns - "HELLO"
'********************************************************************
    vData = Trim(vData, TRAILING, vbLf, YES)
    StripCrLf = Trim(vData, TRAILING, vbCr, YES)
End Function