Here's a function to get Characters up to Specified Character (1 Viewer)

hk1

Registered User.
Local time
Today, 11:22
Joined
Sep 1, 2009
Messages
121
I'm unsure if something like this already exists somewhere or not. Maybe someone has already programmed a better function than this. I do occasionally need to get a certain portion of a text string like the last part of an email address for example. Here's a fairly powerful function that will return all characters in a string up to a specified "stop value". You can opt to included the stop value if you like. You can also specify that you want all characters up to the nth incident of the specified stop value.

I'm posting here in hopes that A) someone can look it over and point out any flaws they see in the way the function is designed or even in the naming of it B) that the function will be of value to someone else.


Code:
Public Function fGetCharsUpTo(sString As String, sStopChar As String, _
                    Optional bIncludeStopChar As Boolean = False, _
                    Optional iIncident As Integer = 1, _
                    Optional bLeftToRight As Boolean = True) As String
    
     'This function is designed to return everything in a string up to the specified character
     'It also allows you to return the specified stop character as well as
     'specify which incidence of the given stop character you'd like to stop at
     
     'Examples:
     'fGetCharsUpTo("someone@email.com", "@", False, 1, True) 'returns 'someone'
     'fGetCharsUpTo("someone@email.com", "@", False, 1, False) 'returns 'email.com'
     'fGetCharsUpTo("someone@email.com", "@", True, 1, True) 'returns 'someone@'
     'fGetCharsUpTo("someone@email.com", "@", True, 1, False) 'returns '@email.com'
     'fGetCharsUpTo("3.75", ".", True, 1, False) 'returns '.75'
     'fGetCharsUpTo("3.75", ".", False, 1, False) 'returns '75'
     'fGetCharsUpTo("3.75", ".", True, 1, True) 'returns '3.'
     'fGetCharsUpTo("3.75", ".", False, 1, True) 'returns '3'
     'fGetCharsUpTo("C:\Documents and Settings\John Davis\My Documents", "\", False, 1, False) 'returns 'My Documents'
     'fGetCharsUpTo("C:\Documents and Settings\John Davis\My Documents", "\", True, 1, False) 'returns '\My Documents'
     'fGetCharsUpTo("C:\Documents and Settings\John Davis\My Documents", "\", False, 2, True) 'returns 'C:\Documents and Settings'
     'fGetCharsUpTo("C:\Documents and Settings\John Davis\My Documents", "\", True, 2, True) 'returns 'C:\Documents and Settings\'
     'fGetCharsUpTo("C:\Documents and Settings\John Davis\My Documents", "\", False, 3, True) 'returns 'C:\Documents and Settings\John Davis'
     'fGetCharsUpTo("C:\Documents and Settings\John Davis\My Documents", "\", True, 3, True) 'returns 'C:\Documents and Settings\John Davis\'
     
     

     
     
    fGetCharsUpTo = "Error"
    
    If sString = "" Or sStopChar = "" Or iIncident < 1 Then
        'We need to at least have a string and a stop character passed in
        '0 or less is not a legitimate value for iIncident
        Exit Function
    Else
        'Let's first check to see if the specified stop character actually exists
        If InStr(sString, sStopChar) = 0 Then
            'Stop character doesn't even exist in the specified string
            fGetCharsUpTo = sString
            Exit Function
        End If
        
        Dim s As String, iLen As Integer, iIncdnt As Integer, i As Long
        
        iIncdnt = 1
        If bLeftToRight = True Then
            
                iLen = Len(sString)
                Do Until i = iLen
                    If Left(sString, 1) <> sStopChar Then
                        s = s & Left(sString, 1)
                        sString = right(sString, Len(sString) - 1) 'take one off
                        i = i + 1
                    Else
                        If iIncdnt = iIncident Then
                            i = iLen
                            If bIncludeStopChar = True Then s = s & Left(sString, 1)
                        Else
                            s = s & Left(sString, 1)
                            sString = right(sString, Len(sString) - 1) 'take one off
                            i = i + 1
                            iIncdnt = iIncdnt + 1
                        End If
                    End If
                Loop
                fGetCharsUpTo = s
        
        Else

                iLen = Len(sString)
                Do Until iLen = 0
                    If right(sString, 1) <> sStopChar Then
                        s = right(sString, 1) & s
                        sString = Left(sString, Len(sString) - 1) 'take one off
                        iLen = Len(sString)
                    Else
                        If iIncdnt = iIncident Then
                            iLen = 0
                            If bIncludeStopChar = True Then s = right(sString, 1) & s
                        Else
                            iIncdnt = iIncdnt + 1
                        End If
                    End If
                Loop
                
                fGetCharsUpTo = s
            
        End If
    End If
    
End Function

Usage:
Code:
     MsgBox fGetCharsUpTo("someone@email.com", "@", False, 1, True) 'returns 'someone'
     MsgBox fGetCharsUpTo("someone@email.com", "@", False, 1, False) 'returns 'email.com'
     MsgBox fGetCharsUpTo("someone@email.com", "@", True, 1, True) 'returns '@someone'
     MsgBox fGetCharsUpTo("someone@email.com", "@", True, 1, False) 'returns '@email.com'
     MsgBox fGetCharsUpTo("3.75", ".", True, 1, False) 'returns '.75'
     MsgBox fGetCharsUpTo("3.75", ".", False, 1, False) 'returns '75'
     MsgBox fGetCharsUpTo("3.75", ".", True, 1, True) 'returns '3.'
     MsgBox fGetCharsUpTo("3.75", ".", False, 1, True) 'returns '3'
     MsgBox fGetCharsUpTo("C:\Documents and Settings\John Davis\My Documents", "\", False, 1, False) 'returns 'My Documents'
     MsgBox fGetCharsUpTo("C:\Documents and Settings\John Davis\My Documents", "\", True, 1, False) 'returns '\My Documents'
     MsgBox fGetCharsUpTo("C:\Documents and Settings\John Davis\My Documents", "\", False, 2, True) 'returns 'C:\Documents and Settings'
     MsgBox fGetCharsUpTo("C:\Documents and Settings\John Davis\My Documents", "\", True, 2, True) 'returns 'C:\Documents and Settings\'
     MsgBox fGetCharsUpTo("C:\Documents and Settings\John Davis\My Documents", "\", False, 3, True) 'returns 'C:\Documents and Settings\John Davis'
     MsgBox fGetCharsUpTo("C:\Documents and Settings\John Davis\My Documents", "\", True, 3, True) 'returns 'C:\Documents and Settings\John Davis\'
 

vbaInet

AWF VIP
Local time
Today, 18:22
Joined
Jan 22, 2010
Messages
26,374
I'll throw some alternatives using built-in functions:
Code:
     'fGetCharsUpTo("someone@email.com", "@", False, 1, True) 'returns 'someone'
     'mid("someone@email.com", 1, (len("someone@email.com") - instr(1, "someone@email.com", "@")) -2)
     
     'fGetCharsUpTo("someone@email.com", "@", False, 1, False) 'returns 'email.com'
     'mid("someone@email.com", instr(1, "someone@email.com", "@") + 1)
     
     'fGetCharsUpTo("someone@email.com", "@", True, 1, True) 'returns 'someone@'
     'mid("someone@email.com", 1, (len("someone@email.com") - instr(1, "someone@email.com", "@")) -1)
     
     'fGetCharsUpTo("someone@email.com", "@", True, 1, False) 'returns '@email.com'
     'mid("someone@email.com", instr(1, "someone@email.com", "@"))

     'fGetCharsUpTo("C:\Documents and Settings\John Davis\My Documents", "\", True, [COLOR=Red][B]2[/B][/COLOR], True) 'returns 'C:\Documents and Settings\'
     'mid("C:\Documents and Settings\John Davis\My Documents", 1, instrrev(replace("C:\Documents and Settings\John Davis\My Documents", "\", "\|.|\",1, [COLOR=Red][B]2[/B][/COLOR]), "\|.|\") - 4)
Most (or some) of these functions are optimised so if I can avoid looping through the string I would. I'm talking in relation to finding portions of string within a string. Where your code is useful is when the iIncident parameter is in use. Although this can still be done as seen in my last counterexample but yours makes for ease of use in that respect.
 

hk1

Registered User.
Local time
Today, 11:22
Joined
Sep 1, 2009
Messages
121
Thanks for the feedback. It dawned on me while driving to lunch that you could get the same results in many cases using some combination of Left, Right, Mid, Len, InStr, and InStrRev. While my code my require more clock cycles I do think it is more natural to use but I realize that point is arguable.
 

vbaInet

AWF VIP
Local time
Today, 18:22
Joined
Jan 22, 2010
Messages
26,374
Yeh in most cases you can. I would definitely cycle if I the incidence of the stop character and if I don't know what kind of characters the string may contain.

Good job though!
 

Users who are viewing this thread

Top Bottom