Posted By

BDOGG32 on 04/01/15

Tagged

excel

Versions (?)

Last Edited at 04/01/15 09:23am

Statistics

Viewed 840 times

Favorited by 2 user(s)

Related snippets

Extract text from a String

/ Published in: Visual Basic

Two functions that can extract text from a string. Must have the Option Compare Text at the top of the module.

Highlighted TextExpand

â€‹

Option Compare Text
Function Get_Word(text_string As String, nth_word) As String
Dim 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 With
End 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

Report this snippet Tweet

Comments

Subscribe to comments

Comment:

You need to login to post a comment.