Extract # and @ from text in cell

[MarlonvanDijk]

Hello,

I have a large dataset with tweets in them. These are displayed in a single cell as text. I want to extract all hashtags and tags in this tweet and display them in their own cells. For example:

"My bilateral programme will comprise meetings with PM @GakhariaGiorgi and FM @DZalkaliani as well with the chairman of the #Parliament of #Georgia " would give" - @GakhariaGiorgi @DZalkaliani #Parliament #Georgia . Preferably all in their own cell.

I have already tried the following code, but this gave me an error. https://www.mrexcel.com/forum/excel...ing-mentions-hashtags-column-columns-b-c.html

Any help would be very much appreciated.

 

[mohadin]

Hi
what about

Sub testy()
    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        .Pattern = "(#+)+(\w+)"
        Set m = .Execute(Range("a1"))
        ReDim x(1 To m.Count)
        For i = 0 To m.Count - 1
            x(i + 1) = m.Item(i)
        Next
        Cells(1, 2).Resize(UBound(x)) = Application.Transpose(x)
    End With
End Sub

 

[mohadin]

Or may be

Sub testy()
    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        .Pattern = "(#+)+(\w+)"
        Set m = .Execute(Range("a1"))
        ReDim x(1 To m.Count)
        For i = 0 To m.Count - 1
            x(i + 1) = m.Item(i)
        Next
        Cells(1, 2).Resize(UBound(x)) = Application.Transpose(x)
        .Pattern = "(\@+\w+)"
        Set m = .Execute(Range("a1"))
        ReDim x(1 To m.Count)
        For i = 0 To m.Count - 1
            x(i + 1) = m.Item(i)
        Next
        Cells(1, 3).Resize(UBound(x)) = Application.Transpose(x)
    End With
End Sub

 

[Eric W]

Welcome to the Board.

It can be done with formulas too. If your cell is A1, put this formula in B1, then drag right as far as needed:

=IFERROR(TRIM(LEFT(SUBSTITUTE(MID($A1,FIND("|",SUBSTITUTE(SUBSTITUTE($A1,"#","@"),"@","|",COLUMNS($B1:B1))),LEN($A1))," ",REPT(" ",LEN($A1))),LEN($A1))),"")

 

[DanteAmor]

Try this

<table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:290.85px;" /><col style="width:144.48px;" /><col style="width:112.16px;" /><col style="width:103.6px;" /><col style="width:101.7px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td><td >D</td><td >E</td></tr><tr style="height:74px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td >My bilateral programme will comprise meetings with PM @GakhariaGiorgi and FM @DZalkaliani as well with the chairman of the #Parliament of #Georgia " would give</td><td >@GakhariaGiorgi</td><td >@DZalkaliani</td><td >#Parliament </td><td >#Georgia </td></tr></table>

Sub Extract_tweets()
  Dim t, n As Long
  n = 2
  For Each t In Split(Range("A1").Value)
    If InStr(1, t, "@") > 0 Or InStr(1, t, "#") Then
      Cells(1, n).Value = Trim(t)
      n = n + 1
    End If
  Next
End Sub

 

[MarlonvanDijk]

Thanks for all your help! It is much appreciated.

I used the method by Eric W, since this is most intuitive for me. It worked perfectly.
I quickly ran the other methods to see it they worked. It seems like they only work correctly on the first row, but after this doesn't. I only tried this,very quickly so maybe I did something wrong there.
Anyways, thanks again very much!

 

[Eric W]

Glad we could help!

 

[DanteAmor]

Thanks for all your help! It is much appreciated.

I used the method by Eric W, since this is most intuitive for me. It worked perfectly.
I quickly ran the other methods to see it they worked. It seems like they only work correctly on the first row, but after this doesn't. I only tried this,very quickly so maybe I did something wrong there.
Anyways, thanks again very much!

The macro works only for the first cell.
I put the updated macro to work with all the rows in column A. Change 1 In A1 through the row where your data begins

Sub Extract_tweets()
  Dim t, n As Long, c As Range
  For Each c In Range("[COLOR=#ff0000]A1[/COLOR]", Range("A" & Rows.Count).End(xlUp))
    Range(Cells(c.Row, 2), Cells(c.Row, Columns.Count)).ClearContents
    n = 2
    For Each t In Split(c.Value)
      If InStr(1, t, "@") > 0 Or InStr(1, t, "#") Then
        Cells(c.Row, n).Value = Trim(t)
        n = n + 1
      End If
    Next
  Next
End Sub