# Posted By

BDOGG32 on 04/01/15

# Statistics

Viewed 203 times
Favorited by 2 user(s)

# Extract text from a String

/ Published in: Visual Basic
`â€‹ Option Compare TextFunction Get_Word(text_string As String, nth_word) As StringDim lWordCount As Long        With Application.WorksheetFunction        lWordCount = Len(text_string) - Len(.Substitute(text_string, " ", "")) + 1        If IsNumeric(nth_word) Then           nth_word = nth_word - 1            Get_Word = Mid(Mid(Mid(.Substitute(text_string, " ", "^", nth_word), 1, 256), _                .Find("^", .Substitute(text_string, " ", "^", nth_word)), 256), 2, _                .Find(" ", Mid(Mid(.Substitute(text_string, " ", "^", nth_word), 1, 256), _                .Find("^", .Substitute(text_string, " ", "^", nth_word)), 256)) - 2)        ElseIf nth_word = "First" Then            Get_Word = Left(text_string, .Find(" ", text_string) - 1)        ElseIf nth_word = "Last" Then            Get_Word = Mid(.Substitute(text_string, " ", "^", Len(text_string) - _            Len(.Substitute(text_string, " ", ""))), .Find("^", .Substitute(text_string, " ", "^", _            Len(text_string) - Len(.Substitute(text_string, " ", "")))) + 1, 256)        End If    End WithEnd Function Function ExtractElement(Txt, n, Separator) As String'   Returns the nth element of a text string, where the elements'   are separated by a specified separator character    Dim Txt1 As String, TempElement As String    Dim ElementCount As Integer, i As Integer     Txt1 = Txt'   If space separator, remove excess spaces    If Separator = Chr(32) Then Txt1 = Application.Trim(Txt1) '   Add a separator to the end of the string (if necessary)    If Right(Txt1, 1) <> Separator Then Txt1 = Txt1 & Separator '   Initialize    ElementCount = 0    TempElement = "" '   Extract each element    For i = 1 To Len(Txt1)        If Mid(Txt1, i, 1) = Separator Then            ElementCount = ElementCount + 1            If ElementCount = n Then'               Found it, so exit                ExtractElement = TempElement                Exit Function            Else                TempElement = ""            End If        Else            TempElement = TempElement & Mid(Txt1, i, 1)        End If    Next i    ExtractElement = ""End Function`