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

OilEconomist

Board Regular
Joined
Dec 26, 2016
Messages
226
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
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,675
Office Version
  1. 2010
Platform
  1. Windows
But you say there could be other $ signs that you do not want... those would always be numbers only then?
 

Some videos you may like

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).

OilEconomist

Board Regular
Joined
Dec 26, 2016
Messages
226
Office Version
  1. 2019
Platform
  1. Windows
They will always have letters and I felt that this was clear when I indicated "search an existing sheet for all the words/tickers that begin with a $ and return the entire word less the $"

The values can consist of letters, numbers, or a combination of both. What I'm searching through is a stock ticker.

Thanks!
My objective is to copy just items that consist of letters, or a combination of both. What I'm searching through is a stock ticker.
 

OilEconomist

Board Regular
Joined
Dec 26, 2016
Messages
226
Office Version
  1. 2019
Platform
  1. Windows
But you say there could be other $ signs that you do not want... those would always be numbers only then?
My objective is to copy just items that consist of letters, or a combination of both letters and numbers. What I'm searching through is a stock ticker.

If "$" sign is followed by a number, like $50,000 or $100, I do not want to copy it.
 

OilEconomist

Board Regular
Joined
Dec 26, 2016
Messages
226
Office Version
  1. 2019
Platform
  1. Windows
Sub test() Dim a, b, m As Variant Dim i, ii As Long With Sheets("Sheet1") a = .Cells(3, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row - 2) End With ReDim b(1 To UBound(a) * 2) ii = 1 With CreateObject("VBScript.RegExp") .Global = True .Pattern = "\$\w+" For i = 1 To UBound(a) Set m = .Execute(a(i, 1)) b(ii) = Mid(m(0), 2): b(ii + 1) = Mid(m(1), 2): ii = ii + 2 Next End With Sheets("Tickers").Cells(2, 1).Resize(UBound(b)) = Application.Transpose(b) End Sub
Thanks so much.

When I ran it, I received the message the message "Run-time error '5': Invalid procedure call or argument" on the following section

VBA Code:
b(ii) = Mid(m(0), 2)

of the following line

VBA Code:
b(ii) = Mid(m(0), 2): b(ii + 1) = Mid(m(1), 2): ii = ii + 2
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,675
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

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
 

OilEconomist

Board Regular
Joined
Dec 26, 2016
Messages
226
Office Version
  1. 2019
Platform
  1. Windows
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
@Rick Rothstein Thanks so much.

So it does leave space rows, but I think it's because when the MS Word document is converted to a pdf file, it leaves spaces between some of the $ and words. So what happens is the macro will copy the $ and then remove it and leave a blank space. Is there a way to first check if there is a blank space after the $ and if so, eliminate it. Also, I think it eliminates whole numbers like $4 or $400, but not $0.40. Is there a way to eliminate values like $0.40?

You are definitely very advanced of the advanced like many of the folks who responded versus a novice like me. What I'm afraid of is if I make additions to this, and I have a question, others may not be able to resolve it.
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,675
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

Is there a way to eliminate values like $0.40?
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
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows
Thanks for the additional information.
it leaves spaces between some of the $ and words.
This could still be an issue as that 'space' may or may not be a normal space. However, give this one a try.
This does not have the 65,000 rows restriction and checks all columns as requested.

VBA Code:
Sub Get_Tickers_v2()
  Dim RX As Object, m As Object
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
 
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.Pattern = " \$ *[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("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(k).Value = b
End Sub

If still failures, please remember ..
For the future I suggest that you investigate XL2BB for providing sample data that shows the variety of data that might be encountered & expected results. As well as showing variety, it also makes it easier for helpers to understand just what you have & where it is and can be easily copied for testing.
 

OilEconomist

Board Regular
Joined
Dec 26, 2016
Messages
226
Office Version
  1. 2019
Platform
  1. Windows
Thanks for the additional information.

This could still be an issue as that 'space' may or may not be a normal space. However, give this one a try.
This does not have the 65,000 rows restriction and checks all columns as requested.

VBA Code:
Sub Get_Tickers_v2()
  Dim RX As Object, m As Object
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long

  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.Pattern = " \$ *[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("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(k).Value = b
End Sub

If still failures, please remember ..
Thanks @Peter_SSs. I'll try to check when I get a chance.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,291
Messages
5,595,274
Members
413,984
Latest member
stikpet

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
Top