VBA Code to Find Words with $ at The Beginning and then paste in another sheet

OilEconomist

Active Member
Joined
Dec 26, 2016
Messages
421
Office Version
  1. 2019
Platform
  1. Windows
Thanks in advance for your assistance as I will give feedback regardless whether it works or not.

Apologies if the requested or similar code exists as I have searched the internet and this forum, but have not been successful.

I would like to search an existing sheet for all the words/tickers that begin with a $ and return the entire word less the $, do a different sheet. So for example,

Cell A3: $SPY and $QQQ are going up tomorrow.
Cell A4: $VIX and $MRNA will be on a downward trend.

I would like the following posted in the same workbook in a sheet called "Tickers"
Cell A2: SPY
Cell A3: QQQ
Cell A4: VIX
Cell A5: MRNA

Here is the start of my code:


VBA Code:
Sub GetTicker()

'________________________________________________________________________________________________________
'Turn off alerts, screen updates, and automatic calculation
        'Turn off Display Alerts
            Application.DisplayAlerts = False

        'Turn off Screen Update
            Application.ScreenUpdating = False

        'Turn off Automatic Calculations
            Application.Calculation = xlManual


'________________________________________________________________________________________________________
'Dimensioning
    Dim LastRow As Long
    
    Dim Ticker As String






'________________________________________________________________________________________________________
'Find the LastRow
    Sheets("Sheet1").Activate
        LastRow1 = Cells.Find(What:="*", after:=Range("A1"), LookAt:=xlPart, _
            LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
            MatchCase:=False).Row
    End With
    'MsgBox LastRow


'________________________________________________________________________________________________________
'Loop through and find all the ones with the $ at the beginning of the words
    
    For i = 1 To LastRow1
        Sheets("Sheet1").Activate
            
            'This is the code that is missing
            'Find all values in the sheet that begins with a $ and is followed by letters and then just store the_
                'letters in string "Ticker"
   
                
    
    
        Sheets("Sheet2").Activate
            'Find the last row and past the ticker into it.
                LastRow2 = Cells.Find(What:="*", after:=Range("A1"), LookAt:=xlPart, _
                    LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row
                    
                Cells("A" & LastRow2).Value = Ticker
    
    Next i

'________________________________________________________________________________________________________
'Turn on alerts, screen updates, and calculate

        'Turn On Display Alerts
            Application.DisplayAlerts = True

        'Turn on Screen Update
            Application.ScreenUpdating = True

        'Turn off Automatic Calculations
            Calculate

'Place the curser in cell



End Sub
 
I'm finding those three statements above confusing.
Thanks @Peter_SSs for your response and apologies for the confusion. Let's say ignore those three statements and let me answer your questions and the clarify my objective.


Hopefully this will clarify. Just suppose there is only one Watch List sheet & it is called 'Sheet1' and contains only this data.
I will answer your question next based on considering the aforementioned although I have more Play tabs than "All", "Main" and "Backburners"


What exactly would go on sheets 'Main' and 'Backburners' and in what columns?
Per the logic of your VBA, the following goes into the "All" tab.
Column C: SPY and QQQ
Column E: # and $

So:
cell C7 contains "SPY" and cell E7 contains "#"
cell C8 contains "QQQ" and cell E8 contains "$"

I would also like the following in column B (the tab name where the data comes from)
B7: "Sheet1"
B8: "Sheet1"

In the Tab "Main"
cell C7 contains "QQQ" and cell E7 contains "Main"
I would also like "Sheet1" to appear in cell B7

In the Tab "Backburners"
cell C7 contains "SPY" and cell E7 contains "#"
I would also like "Sheet1" to appear in cell B7

One thing to note is I continuously add new Watchlists to extract data to the Play tabs. I just remove the old Watchlists before I do this since I already extracted the data from them. Your code lets me do this. It works perfectly. I'm just trying to get the Watchlist tab name also.

Let me further explain.
There are five tabs between “PLAYS.START” and “PLAYS.END”. The data is moved from the Watchlists into two of the five tabs. All the data goes into the “All” tab, and based on the symbol before the ticker, it also then goes to one of the following tabs:
  • “Main”
  • “Scalps”
  • “Backburners”
  • “Sympathy”

There are numerous Watchlists tabs between “WL.START” and “WL.END”. This is the source data as you indicate to “Just suppose there is only one Watch List sheet & it is called 'Sheet1' and contains only this data.” These Watchlist tabs are for example as follows:
  • “2021.01.25”
  • “2021.01.26”
  • “2021.01.27”
  • “2021.01.28”
  • “2021.01.29”
For the “All” tab
Right now, the first part of your code takes all the tickers with the symbols “$”, “@”, “^” and “#” from “Sheet1” and places the ticker without the symbol into Column C and then the respective symbol into Column E within the “All” tab. That’s exactly what I want it to do.

I then add additional code to translate those symbols within Column E of the “All” tab as follows:
  • “$” to “Main”
  • “@” to “Scalp”
  • “^” to “Backburner”
  • “#” to “Sympathy”

I would also like to add the tab name, which is basically the date, in Column B of the “All” play tab. So, if it gets the tickers from “2021.01.25” I would like to place that in Column B. I will then convert into the date in format “2021-01-25, Monday”.

I then add additional code later to number them and place those values in Column A. For example, say there are 25 tickers from the “2021.01.25” Watchlist tab and 10 tickers from the “2021.01.26” Watchlist tab. The tickers from the “2021.01.25” are numbered from 1 – 25, and the tickers from the “2021.01.26” are numbered from 1 – 30.


Second Part
The second part of your code takes the data from the Watchlist tabs and places them in their respective tab. The respective tabs where the data ends up is follows:
  • “Main” for “$”
  • “Scalps” for “@”
  • “Backburners” to “^”
  • “Sympathy” to “#”
The ticker goes in Column C without the symbol. The type of play (“Main”, “Scalp”, “Backburner”, and “Sympathy) goes into column E. Your code does exactly this.

I would also like to put the source tab name in Column B just as I wanted to do for the “All” tab. I will then number them for each source just like I do for the "All" tab.

Thanks!
 
Upvote 0

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
See how this goes then. I have tried to address everything as I understand it except that I have left the numbering to you still.

VBA Code:
Sub Get_Tickers_v5()
  Dim RX As Object, m As Object
  Dim a As Variant, b As Variant, tmp As Variant
  Dim i As Long, j As Long, k As Long, shIdx As Long
  Dim shName As String
  
  Const myChars As String = "\$|\@|\^|\#"
  Const TickerSheets As String = "Main|Scalps|Backburners|Sympathy"
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.Pattern = " (" & myChars & ") *[A-Za-z].+?\b"
  ReDim b(1 To Rows.Count)
  For shIdx = Sheets("WL.Start").Index + 1 To Sheets("WL.End").Index - 1
    a = Sheets(shIdx).UsedRange.Value
    shName = Format(DateValue(Replace(Left(Sheets(shIdx).Name, 10), ".", "-")), "yyyy-mm-dd, dddd") & ";"
    For j = 1 To UBound(a, 2)
      For i = 1 To UBound(a)
        For Each m In RX.Execute(" " & a(i, j))
          k = k + 1
          b(k) = shName & Mid(m, 2)
        Next m
      Next i
    Next j
  Next shIdx
  With Sheets("All").Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(k)
    .Value = Application.Transpose(b)
    .TextToColumns DataType:=xlDelimited, Semicolon:=True, Space:=False, Other:=False
    .Offset(, 1).TextToColumns Destination:=.Offset(, 3), DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(1, 9))
    .Offset(, 1).TextToColumns DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 9), Array(1, 1))
  End With
  For j = 1 To 4
    tmp = Filter(b, Mid(myChars, (j * 3 - 1), 1))
    If UBound(tmp) > -1 Then
      With Sheets(Split(TickerSheets, "|")(j - 1))
        With .Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(tmp) + 1)
          .Value = Application.Transpose(tmp)
          .TextToColumns DataType:=xlDelimited, Semicolon:=True, Space:=False, Other:=False
          .Offset(, 1).TextToColumns DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 9), Array(1, 1))
          .Offset(, 3).Value = .Parent.Name
        End With
      End With
    End If
  Next j
End Sub
 
Upvote 0
Solution
See how this goes then. I have tried to address everything as I understand it except that I have left the numbering to you still.

VBA Code:
Sub Get_Tickers_v5()
  Dim RX As Object, m As Object
  Dim a As Variant, b As Variant, tmp As Variant
  Dim i As Long, j As Long, k As Long, shIdx As Long
  Dim shName As String
 
  Const myChars As String = "\$|\@|\^|\#"
  Const TickerSheets As String = "Main|Scalps|Backburners|Sympathy"
 
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.Pattern = " (" & myChars & ") *[A-Za-z].+?\b"
  ReDim b(1 To Rows.Count)
  For shIdx = Sheets("WL.Start").Index + 1 To Sheets("WL.End").Index - 1
    a = Sheets(shIdx).UsedRange.Value
    shName = Format(DateValue(Replace(Left(Sheets(shIdx).Name, 10), ".", "-")), "yyyy-mm-dd, dddd") & ";"
    For j = 1 To UBound(a, 2)
      For i = 1 To UBound(a)
        For Each m In RX.Execute(" " & a(i, j))
          k = k + 1
          b(k) = shName & Mid(m, 2)
        Next m
      Next i
    Next j
  Next shIdx
  With Sheets("All").Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(k)
    .Value = Application.Transpose(b)
    .TextToColumns DataType:=xlDelimited, Semicolon:=True, Space:=False, Other:=False
    .Offset(, 1).TextToColumns Destination:=.Offset(, 3), DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(1, 9))
    .Offset(, 1).TextToColumns DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 9), Array(1, 1))
  End With
  For j = 1 To 4
    tmp = Filter(b, Mid(myChars, (j * 3 - 1), 1))
    If UBound(tmp) > -1 Then
      With Sheets(Split(TickerSheets, "|")(j - 1))
        With .Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(tmp) + 1)
          .Value = Application.Transpose(tmp)
          .TextToColumns DataType:=xlDelimited, Semicolon:=True, Space:=False, Other:=False
          .Offset(, 1).TextToColumns DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 9), Array(1, 1))
          .Offset(, 3).Value = .Parent.Name
        End With
      End With
    End If
  Next j
End Sub
@Peter_SSs Wow! At first attempt this works exactly to the T! Will work on combing through all the data to confirm. Thanks so much! I have been working night and day for like the past five weeks on the this tool I'm building!
 
Upvote 0
@Peter_SSs Wow! At first attempt this works exactly to the T! Will work on combing through all the data to confirm. Thanks so much! I have been working night and day for like the past five weeks on the this tool I'm building!
Sounds promising. I hope that it stands up to you testing. :)
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top