Advanced Search

Return to Snippet

Revision: 68992
at April 1, 2015 09:23 by BDOGG32
Initial Code 
​

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
Initial URL 

                                

                                                            

                                    

                                        

                                        Initial Description
                                        

                                    

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

                                

                                                            

                                    

                                        

                                        Initial Title
                                        

                                    

                                    
Extract text from a String

                                

                                                            

                                    

                                        

                                        Initial Tags
                                        

                                    

                                    
excel

                                

                                                            

                                    

                                        

                                        Initial Language
                                        

                                    

                                    
Visual Basic