Extract string from cell arrays vba

Question

The code below finds a string in a cell and extracts both the search word and the word that come before it.

When the search word is left as "(hello)" the code works but when I make it "(hello hey)" the code cannot find it. I assume its the white space in between "hello" and "hey" but I'm not sure how to make that change.

Dim c As Range, v As String, arr, x As Long, e
    Dim d As Range


    Set d = WorkSheets("Sheet1").Range("F1") '<<results start here

    For Each c In ActiveSheet.Range("D1:D10")
        v = Trim(c.Value)
        If Len(v) > 0 Then

            'normalize other separators to spaces
            v = Replace(v, vbLf, " ")
            'remove double spaces
            Do While InStr(v, "  ") > 0
                v = Replace(v, "  ", " ")
            Loop

            'split to array
            arr = Split(v, " ")
            For x = LBound(arr) To UBound(arr)
                e = arr(x)
                'see if array element is a word of interest
                If Not IsError(Application.Match(LCase(e), Array("(hello hey)"), 0)) Then
                    If x > LBound(arr) Then
                        d.Value = arr(x - 1) & " " & e 'prepend previous word
                    Else
                        d.Value = "??? " & e 'no previous word
                    End If
                    Set d = d.Offset(1, 0)
                End If
            Next x
        End If
   Next c
End Sub

"(hello hey)" will never be matched, because it contains a space, and you're splitting all your cell values on space (and so no values in arr will contain spaces). — Tim Williams
– Tim Williams, Commented Aug 22, 2016 at 22:05
@TimWilliams Is there a way to treat the inside of a parentheses as a single vaule? — johndoe253
– johndoe253, Commented Aug 22, 2016 at 22:10

Slai · Accepted Answer · 2016-08-23 00:14:47Z

1

Instead of splitting by space, you can split by the search word and then by space:

Dim ws1 as WorkSheet, d As Range, c As Range
Dim v As String, arr() As String

Set ws1 = WorkSheets("Sheet1")
Set d = ws1.Range("F1") '<<results start here

For Each c In ws1.Range("D1:D10")
    v = WorksheetFunction.Trim(c.Value2) ' the Excel function TRIM() also replaces extra spaces between words to one space
    arr = Split(v, "(hello hey)")
    If UBound(arr) > 0 Then 
        v = arr(0)
        v = Replace(v, vbLf, " ")
        v = Trim(v)
        arr = Split(v) ' split by space to get the last word before the search word
        v = arr(UBound(arr)) ' the last word in arr

        d.Value2 = v
        Set d = d.Offset(1)
    End If
Next c

answered Aug 23, 2016 at 0:14

Slai

23k5 gold badges49 silver badges55 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

johndoe253 Over a year ago

Thanks for the help!

cyboashu · Accepted Answer · 2016-08-22 23:18:41Z

1

One approach will be to just replace the first space with a different character (e.g ^) and leave the rest of the spaces intact. Now split the string on the basis of that newly introduced char.

So, Hi (hello hey) ---> Hi^(hello hey) ---> arr(0)= Hi and arr(1)= (hey hello)

Edit : Updated the code to handle multiple entries. Instead of replacing space, replace the ( and ). See the comments inside code for more details.

Sub test()

    Dim c As Range, v As String, arr, x As Long, e
    Dim d As Range

    Dim arr2


    Set d = Worksheets("Sheet1").Range("F1") '<<results start here

    For Each c In ActiveSheet.Range("D1:D10")
        v = Trim(c.Value)
        If Len(v) > 0 Then

            'normalize other separators to spaces
            v = Replace(v, vbLf, " ")
            'remove double spaces
            Do While InStr(v, "  ") > 0
                v = Replace(v, "  ", " ")
            Loop

            '/ Replace just the first space with ^
            'v = Replace(v, Space(1), "^", , 1) --- Commented as it wont work with multiple entries

            '/ Updated as per your edit in question.
            '/ Replace parenthesis with ^ appended.
            v = Replace(v, Space(1) & "(", "^(")
            v = Replace(v, ")", ")^")

            'split to array
            '/ Now split the array on ^, this way you get to keep the full string inside parenthesis
            arr = Split(v, "^")

            For x = LBound(arr) To UBound(arr)
                e = arr(x)
                'see if array element is a word of interest
                If Not IsError(Application.Match(LCase(e), Array("(hello hey)"), 0)) Then
                    If x > LBound(arr) Then
                        d.Value = arr(x - 1) & " " & e 'prepend previous word

                        '/ This part added as per your edit.
                        '/ It will bring back the word which precedes the search term.
                        arr2 = Split(StrReverse(Trim(arr(x - 1))), Space(1))
                        If UBound(arr2) > 0 Then
                            arr2(UBound(arr2)) = ""
                        End If
                        d.Value = Trim(StrReverse(Join(arr2, Space(1)))) & " " & e

                    Else
                        d.Value = "??? " & e 'no previous word
                    End If
                    Set d = d.Offset(1, 0)
                End If
            Next x
        End If
   Next c

End Sub

edited Aug 22, 2016 at 23:18

answered Aug 22, 2016 at 22:43

cyboashu

10.5k2 gold badges32 silver badges48 bronze badges

4 Comments

johndoe253 Over a year ago

When there are sentences that are in the cell it cannot get to it but when its just the HI (hello hey). How can it account for indentations and sentences in the cell?

johndoe253 Over a year ago

I'll add a screen shot

johndoe253 Over a year ago

In the screen shot it shows that it pulls almost all the HI but the last one that is in the paragraph

cyboashu Over a year ago

see the updated answer. Works for me as per your updated screenshot.

user6432984 · Accepted Answer · 2016-08-23 01:45:50Z

1

I use Instr to find the phrase in the text then RegEx to find the last word before the phrase.

Function getWordBeforePhrase(text As String, phrase As String) As String

    Dim regex As Object, Match As Object
    Dim lEnd As Long

    lEnd = InStr(text, phrase) - 1

    If lEnd Then
        text = Left(text, lEnd)

        Set regex = CreateObject("VBScript.RegExp")
        With regex
            .Global = True
            .Pattern = "\w+"
            Set matches = regex.Execute(text)

        End With

        If matches.Count Then getWordBeforePhrase = matches(matches.Count - 1).Value

        Set regex = Nothing

    End If

End Function

answered Aug 23, 2016 at 1:45

user6432984

3 Comments

Ron Rosenfeld Over a year ago

No need for InStr. Just use a single regex. Something like: "\w+(?=\W*" & phrase & ")". Just need to be careful to escape the parentheses when entering phrase. e.g. "\(hello hey\)" or other special characters.

user6432984 Over a year ago

Thanks. I tried something similar but couldn't get it to work.

johndoe253 Over a year ago

Thanks for the help

Collectives™ on Stack Overflow

Extract string from cell arrays vba

3 Answers 3

1 Comment

4 Comments

3 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

1 Comment

4 Comments

3 Comments

Your Answer

Sign up or log in

Post as a guest

Related