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
 
Give this a try...
VBA Code:
Sub GetDollarSignWords()
  Dim Arr As Variant
  Application.ScreenUpdating = False
  Arr = Split(Join(Application.Transpose(Sheets("Sheet1").Range("A1", Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)))))
  Arr = Filter(Arr, "$")
  Sheets("Tickers").Range("A2").Resize(UBound(Arr) + 1) = Application.Transpose(Arr)
  Sheets("Tickers").Columns("A").Replace "$ ", "$", xlWhole, , , , False, False
  Sheets("Tickers").Columns("A").Replace "$", "", xlPart, , , , False, False
  Sheets("Tickers").Columns("A").SpecialCells(xlConstants, xlNumbers).Delete xlShiftUp
  Application.ScreenUpdating = True
End Sub
Hi Rick and thanks for your help as it is working. I want to know how I can have a series of symbols I look up, but if I
Give this macro a try...
VBA Code:
Sub GetDollarSignWords()
  Dim Arr As Variant
  Application.ScreenUpdating = False
  Arr = Split(Join(Application.Transpose(Sheets("Sheet1").Range("A1", Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)))))
  Arr = Filter(Arr, "$")
  Sheets("Tickers").Range("A2").Resize(UBound(Arr) + 1) = Application.Transpose(Arr)
  Sheets("Tickers").Columns("A").Replace "$", "", xlPart, , , , False, False
  Sheets("Tickers").Columns("A").SpecialCells(xlConstants, xlNumbers).Delete xlShiftUp
  Application.ScreenUpdating = True
End Sub
Hi @Rick Rothstein this worked for me. I appreciate it.

Now @Rick Rothstein and or @Peter_SSs, I want to see about getting several symbols and want to know if I should start a new thread with the code @Rick Rothstein has put together and ask how it should be changed or just ask here. I am wanting it to filter for several symbols. Please let me know as I do not want to violate the form rules. I just read them again and I don't believe I saw where it stated what to do in a situation like this.

Is there a way to filter if the Arr = Filter(Arr, Symbol) where the Symbol could be "$", "@", "^", or "#"?

Basically if the data was as follows in sheet "SheetData"
Cell A3: $SPY and $QQQ are going up tomorrow.
Cell A4: @ABUS and ^RKT are going down
Cell A5: #MDGS is a good one and so is $MSFT.
Cell A6: $AAPL, #FB, ^GOOGL, and @nflx always do well.
Cell A7: $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 A7: SPY
Cell A8: QQQ
Cell A10: ABUS
Cell A11: RKT
Cell A12: MDGS
Cell A13: MSFT
Cell A14: AAPL
Cell A15: FB
Cell A16: GOOGL
Cell A17: NFLX
Cell A18: VIX
Cell A19: MRNA


Thanks!
 
Upvote 0

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Since you are looking for modifications to Rick's code, can you confirm that you now only want to check one column of data not all columns like you stated in post #8?
 
Upvote 0
Uh, I only see Peter's question in your message with no answer by you to the question he asked.
 
Upvote 0
Since you are looking for modifications to Rick's code, can you confirm that you now only want to check one column of data not all columns like you stated in post #8?
Thanks @Peter_SSs. For now I only have data in Column A, but I wanted to be able to have it any column so whatever Rick's original code does. If it does it for all columns, I would like to continue with that method, but if it does it just one column, that's fine also. Hope that clarifies.
 
Upvote 0
Truthfully, for the added functionality you want (extra symbols AND multiple columns), I think one of Peter's RegExp macros would be far more efficient than a modification to the code I posted. Would you be willing to use something he develops instead? By the way, just noting that the code I posted earlier is good for one column only, not multiple columns... modifying it to continue to work with only one column is doable, but multiple columns would need a different approach than I used originally.
 
Upvote 0
Truthfully, for the added functionality you want (extra symbols AND multiple columns), I think one of Peter's RegExp macros would be far more efficient than a modification to the code I posted. Would you be willing to use something he develops instead? By the way, just noting that the code I posted earlier is good for one column only, not multiple columns... modifying it to continue to work with only one column is doable, but multiple columns would need a different approach than I used originally.
Thanks @Rick Rothstein for you response. One column is fine. I am willing to try Peter's macros, but I have not worked with them yet, but for the one you provided, I have been using and there is a lot of additional code that I added which depends on your logic. Understandably if you do not have time or unable to modify it without a lot of trouble I will seek an alternate approach.

Once again thanks for your time.
 
Upvote 0
Cell A6: $AAPL, #FB, ^GOOGL, and @nflx always do well.

I would like the following posted in the same workbook in a sheet called "Tickers"
Cell A17: NFLX

Checking the red sample & results. All other examples were upper case letters. Is this a typo with the sample data or do we also have to consider lower case letters after these symboles?

Assuming all data to be extracted is actually upper case, then try this (processes all columns)

VBA Code:
Sub Get_Tickers_v3()
  Dim RX As Object, m As Object
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  
  Const myChars As String = "\$|\@|\^|\#"
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.Pattern = " (" & myChars & ") *[A-Z].+?\b"
  ReDim b(1 To Rows.Count, 1 To 1)
  a = Sheets("Sheet1").UsedRange
  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, 1) = LTrim(Mid(m, 3))
      Next m
    Next i
  Next j
  Sheets("Tickers").Range("A7").Resize(k).Value = b
End Sub
 
Upvote 0
For one column where there Ticker symbols are upper or lower case, give this a try...
VBA Code:
Sub Tickers()
  Dim Txt As String, V As Variant, Arr As Variant
  With Sheets("SheetData")
    Txt = Join(Application.Transpose(.Range("A3", .Cells(Rows.Count, "A").End(xlUp))))
  End With
  For Each V In Array("$", "@", "^")
    Txt = Replace(Txt, V, "#")
    Txt = Replace(Replace(Txt, ".", ""), ",", "")
  Next
  Arr = Filter(Split(UCase(Replace(Txt, Chr(160), " "))), "#")
  With Sheets("Tickers").Range("A7").Resize(UBound(Arr) + 1)
    .Value = Application.Transpose(Arr)
    .Replace "#", "", xlPart, , False, , False, False
  End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,188
Members
448,554
Latest member
Gleisner2

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