VBA that can extract words that starts with # and ends with 2021.

[whyjaydee]

Hi Everyone,

I am straggling to in searching for a vba code that will extract a string that starts with # and ends with 2021. The string has no specific length.
After extracting, I need it to be in one column listed. There can be multiple words that starts with # and ends with 2021 in one cell, note that the 1 cell for example cell A1, contains a paragraph long texts and within that text the code will search for all the words that starts with # and ends with 2021 and put it in another column. If the code found found more than 1 word that starts with # and ends with 2021, then it has to be listed per cell in 1 column.

Example
Here is the paragraph or bunch of words and characters in cell A1:

{"106835224676040":{"id":"106835224676040","time":1613053377,"author":"Luisito Noel Magleo","text":"#RRT2106102112021","highlighted":true,"type":"user"},"106830671343162":{"id":"106830671343162","time":1613052698,"author":"Paul John Honrubia","text":"#RRT_PaulJohnHonrubia","highlighted":true,"type":"user"},"#RRT2106102112021":{"id":"105041188188777","time":1612709664,"author":"Arnel Ramo","text":"#RRT1570702072021","highlighted":true,"type":"user"},"103766651649564":{"id":"103766651649564","time":1612463717,"author":"Algernon Sionosa","text":"

The string in Red font are the words that I need to get in the bunch of characters and needs to be listed in another column like this
Cell B1: #RRT2106102112021
Cell B2: #RRT2106102112021
Cell B3: #RRT1570702072021

Note that the words I'm looking for can appear repeatedly in the same paragraph

I appreciated all kinds of help.

 

[Rick Rothstein]

On what line of code?

 

[whyjaydee]

On what line of code?

It doesn't say

 

[whyjaydee]

It doesn't say

View attachment 33361

I placed the code in module and it highlighted this line

 

[Rick Rothstein]

Without me loading everything up and testing, does this alternate code work?

Sub SplitPound2021TextFromA1ToB1Down()
  Dim N As Long, X As Long, Cell As Range, Arr1 As Variant, Arr2 As Variant
  Columns("B").Clear
  For Each Cell In Range("A1", Cells(Rows.Count, "A"))
    Arr1 = Split(Cell, "#")
    For X = 1 To UBound(Arr1)
      If UCase(Arr1(X)) Like "RR*2021*" Then
        Arr2 = Split(Arr1(X), 2021)
        N = N + 1
        Cells(N, "B") = "#" & Arr2(0) & 2021
      End If
    Next
  Next
End Sub

 

[whyjaydee]

Without me loading everything up and testing, does this alternate code work?

Sub SplitPound2021TextFromA1ToB1Down()
  Dim N As Long, X As Long, Cell As Range, Arr1 As Variant, Arr2 As Variant
  Columns("B").Clear
  For Each Cell In Range("A1", Cells(Rows.Count, "A"))
    Arr1 = Split(Cell, "#")
    For X = 1 To UBound(Arr1)
      If UCase(Arr1(X)) Like "RR*2021*" Then
        Arr2 = Split(Arr1(X), 2021)
        N = N + 1
        Cells(N, "B") = "#" & Arr2(0) & 2021
      End If
    Next
  Next
End Sub

It did work, however it did not extracted those string that begins with #EMAILER (which I also need) and some of the extracted strings included the next string after "2021"

 

[Rick Rothstein]

Okay, try it this way then...

Sub SplitPound2021TextFromA1ToB1Down()
  Dim N As Long, X As Long, Cell As Range, Arr1 As Variant, Arr2 As Variant
  Columns("B").Clear
  For Each Cell In Range("A1", Cells(Rows.Count, "A"))
    Arr1 = Split(Cell, "#")
    For X = 1 To UBound(Arr1)
      If UCase(Arr1(X)) Like "RR*2021*" Or UCase(Arr1(X)) Like "EMAILER*2021*" Then
        Arr2 = Split(Arr1(X), 2021)
        N = N + 1
        Cells(N, "B") = "#" & Arr2(0) & 2021
      End If
    Next
  Next
End Sub

 

[whyjaydee]

Okay, try it this way then...

Sub SplitPound2021TextFromA1ToB1Down()
  Dim N As Long, X As Long, Cell As Range, Arr1 As Variant, Arr2 As Variant
  Columns("B").Clear
  For Each Cell In Range("A1", Cells(Rows.Count, "A"))
    Arr1 = Split(Cell, "#")
    For X = 1 To UBound(Arr1)
      If UCase(Arr1(X)) Like "RR*2021*" Or UCase(Arr1(X)) Like "EMAILER*2021*" Then
        Arr2 = Split(Arr1(X), 2021)
        N = N + 1
        Cells(N, "B") = "#" & Arr2(0) & 2021
      End If
    Next
  Next
End Sub

This works great!
Thank you everyone for helping me!