Need to get text from a website or IE page that is surrounded by parentheses

[dmavro]

I have a few webpages that have a good amount of stocks symbols on them usually. Up to now ive been adding them to my worksheet manually. I create web queries for most of my sites normally, but none of the websites in question are in tabular format therefore I cant just create a query then copy and paste the column with the data I need. One of the sites in question offers an article and also has a list containing quotes for each stock in the article for that day. Here are links for the 2 versions of the site for today....

Article- Pre-Open Stock Movers 8/28: (CREG) (DGLY) (TKMR) Higher; (GOMO) (WSM) (GCO) Lower (more...)

Quotes- StreetInsider.com

I created a web query for each example and I believe using the quotes version of the page would be the best choice to accomplish what i am trying to do. Now I need to find a way to copy and paste just the symbols which are all found inside either...(NYSE:****) or (NASDAQ:****) on each page. The symbols can have anywhere from 1 to 5 text characters, but are always inside the parentheses. The rows they are in always have there background colored RGB(160,201247) so I don't know if that can be used to find the rows since the size of the list always changes. They always seem to be 7 rows apart also. But my biggest issue is trying to pull just the symbol from the rows they are located in. I played around with Left and Right excel functions and tried using Instr but to no avail. The only working code I have is for the web query so im sorry for not having any more then that to offer......

Sub SIpreQuery()
Dim ws As Worksheet
Set ws = Sheets("SI_Premarket")
Dim rng As Range
'http://www.streetinsider.com/Special+Reports/"
    With ws.QueryTables.Add(Connection:= _
        "URL;http://www.streetinsider.com/news_quotes.php?id=9790202" _
        , Destination:=Range("$A$1"))
        .Name = "9712377"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
           
        
End Sub

Any help would be appreciated. Thank you in advance

 

[tyger0951]

This should be a start. This set of macros will copy and paste the data from the website to excel then highlight every line with the (NYSE:****) and (NASDAQ:****) . One yellow and one red. Just add code to sections that set the cells to interior.color to what you want to do with the data.

Sub GetWebData()
 
Application.ScreenUpdating = False
        
Set appIE = CreateObject("InternetExplorer.Application") ' sets appIE as IE object, used as reference quite a bit
sURL = "http://www.streetinsider.com/news_quotes.php?id=9790202" ' URL trying to go to


' Instructes the macro to open IE and navigate to sURL.
With appIE
    .Navigate sURL
    .Visible = False
     Application.Wait Now + TimeValue("00:00:02") 'waits for page to load
 Do While appIE.ReadyState <> READYSTATE_COMPLETE
Application.StatusBar = ""
DoEvents
Loop
       appIE.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT  'selects all on page
      appIE.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT ' copies all on page


appIE.Quit


End With
    
    Range("A1").Select
    ActiveSheet.Paste
Dim Obj As Object
    For Each Obj In ActiveSheet.Shapes ' Deletes all object on selected page
    Obj.Delete
    Next
ActiveSheet.Hyperlinks.Delete
      
      Rows("1:137").Select     ' Cleans Extra data at top
    Selection.Delete Shift:=xlUp
    
    Call Finddata
      Application.ScreenUpdating = True
 End Sub


Sub Finddata()


Dim cell As Range
Dim LastRowColA As Integer


LastRowColA = Range("a" & Rows.Count).End(xlUp).Row


For Each cell In Range("A1", Range("A" & LastRowColA))
    Myvalue = cell.Value
    c = InStr(Myvalue, "NYSE")
        If c > 0 Then
            cell.Interior.Color = vbRed ' Exchange with code to move data
        End If
Next


For Each cell In Range("A1", Range("A" & LastRowColA))
    Myvalue = cell.Value
    c = InStr(Myvalue, "NASDAQ")
        If c > 0 Then
            cell.Interior.Color = vbYellow ' Exchange with code to move data
        End If
Next




End Sub

 

[dmavro]

Thank you! That works like a charm. Going to work with the code tomorrow.