Pulling data points from multiple webpages

J

Jimmywinvests

New Member
Joined
Feb 15, 2016
Messages
22
Hello Exel-sperts (yes i love bad puns),

I have spent weeks reading forums and watching videos only to fail at creating the spreadsheet I set out to; I am hoping that someone on here might be able to help me.
I need to create a spreadsheet which pulls multiple data points (from a few web pages) off yahoo finance. The method however would need to include a macro button which when pressed would refresh the data, as well as work for multiple assessments.

The data I wish to extract (using the company "Telstra" as an example) include the following:


[TABLE="width: 578"]
<tbody>[TR]
[TD]Summary Page[/TD]
[/TR]
[TR]
[TD]https://au.finance.yahoo.com/q?s=TLS.AX[/TD]
[/TR]
[TR]
[TD]Company Name[/TD]
[/TR]
[TR]
[TD]share price[/TD]
[/TR]
[TR]
[TD]Market Cap (mil)[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]Balance Sheet Quartly Page[/TD]
[/TR]
[TR]
[TD]https://au.finance.yahoo.com/q/bs?s=TLS.AX[/TD]
[/TR]
[TR]
[TD]Cash and Cash equilavents (of most recent quarter - i.e. left column)[/TD]
[/TR]
[TR]
[TD]Cash from short term investments (of most recent quarter - i.e. left column)[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]Cash Flow Annual Page[/TD]
[/TR]
[TR]
[TD]https://au.finance.yahoo.com/q/cf?s=TLS.AX&annual[/TD]
[/TR]
[TR]
[TD]Cash from operating activities (most recent annual figure)[/TD]
[/TR]
[TR]
[TD]Capital expenditures (most recent annual figure)[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]Key Statistics Page[/TD]
[/TR]
[TR]
[TD]https://au.finance.yahoo.com/q/ks?s=TLS.AX[/TD]
[/TR]
[TR]
[TD]shares outstanding[/TD]
[/TR]
[TR]
[TD]return on equity[/TD]
[/TR]
[TR]
[TD]revenue growth rate[/TD]
[/TR]
[TR]
[TD]Total debt[/TD]
[/TR]
[TR]
[TD]Operating[/TD]
[/TR]
[TR]
[TD]Forward PE Ratio (optional - include if easy)
[/TD]
[/TR]
</tbody>[/TABLE]


The idea is that this data is scraped off the above websites using the ticker "TLS.AX" as the identifier. Therefore, the headers should populate the first row in the spreadsheet.

The second part to this is that I would need this to work on multiple companies at a time (for example if i listed the circa 2100 companies listed on the ASX in column "A", ideally it would populate all the above listed data for every company; thus allowing the filtering of companies by data point.

Any help is very greatly appreciated. (I am not sure where else to turn to - at this point I even have doubts that excel can fulfill the requirements).

Thank-you to anybody who takes the time to read my problem!

- Jimmy
 
Sort by date Sort by votes
You may have to increase the application wait another second, other than that I'm not sure. If you step through the macro using f8 you can see the data it imports. On the sheet that has the share price day range find the cell value you need and change it in the macro. Hope it works for you. If you need to speed the macro up, you can post another thread on here and ask for help speeding it up. Have fun with the macro.

Mike
 
Upvote 0

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
You should see four lines like this in the macro:Application.Wait (Now + TimeValue("0:00:02"))

change the 2 to 3 and see if that helps.
 
Upvote 0
Hi Mike,
I have stumbled across a serious problem with the information in which the exported data is based.
Long story short, the revenue growth rate column is supposed to pull the revenue growth from "Growth Est, Next 5 years (per annum)" in the bottom table from this page...
(for example - telstra)
[TABLE="width: 64"]
<tbody>[TR]
[TD="class: xl64, width: 64"]https://au.finance.yahoo.com/q/ae?s=tls.AX[/TD]
[/TR]
</tbody>[/TABLE]

the figure would preferably be pulled for both the company specifically (the far left column) and the industry (the second from the left column)

I feel terrible for asking your help once again, but I have attempted to rectify this issue myself and failed...
 
Upvote 0
You will need to add another sheet called Analyst Estimates. My sheets are setup from left to right in this order: Summary, Balance Sheet, Cash Flow, Analyst Estimates, Key Statistics, and Final Summary. Setup your sheets in that order. I have changed the macro so that column j on the final summary sheet gets the value from analyst estimates b41. Let me know if this is what you want. Here is the macro:
Code: 
Sub DynamicURL()
Dim lastRow As Long, r As Long
Dim url As String
Dim symbol As String

lastRow = Sheets("Final Summary").Range("A" & Rows.Count).End(xlUp).Row
If lastRow = Rows.Count Then Exit Sub
Application.ScreenUpdating = False
Application.StatusBar = False

For r = 2 To lastRow
    Sheets("Summary").Activate
    With Sheets("Summary")
    symbol = Sheets("Final Summary").Range("A" & r)
    url = "URL;https://au.finance.yahoo.com/q?s="
    url = url & symbol
    Sheets("Summary").UsedRange.Delete Shift:=xlToLeft
    End With
        With Sheets("Summary").QueryTables.Add(Connection:= _
        url, Destination:=Range("$A$1"))
        .Name = "q?s=TLS.AX_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = """table1"",""table2"""
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        Application.Wait (Now + TimeValue("0:00:02"))
        Sheets("Final Summary").Range("B" & r) = Sheets("Summary").Range("B9")
        Sheets("Final Summary").Range("C" & r) = Sheets("Summary").Range("B13")
        If r <> lastRow Then
           Sheets("Summary").UsedRange.Delete Shift:=xlToLeft
        Else
        End If
    End With
    
    With Sheets("Balance Sheet")
    symbol = Sheets("Final Summary").Range("A" & r)
    url = "URL;https://au.finance.yahoo.com/q/bs?s="
    url = url & symbol
    Sheets("Balance Sheet").UsedRange.Delete Shift:=xlToLeft
    End With
        Sheets("Balance Sheet").Activate
        With Sheets("Balance Sheet").QueryTables.Add(Connection:= _
        url, Destination:=Range("$A$1"))
        .Name = "bs?s=TLS.AX"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "9"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        Application.Wait (Now + TimeValue("0:00:02"))
        Sheets("Final Summary").Range("D" & r) = Sheets("Balance Sheet").Range("C5")
        Sheets("Final Summary").Range("E" & r) = Sheets("Balance Sheet").Range("C6")
        If r <> lastRow Then
           Sheets("Balance Sheet").UsedRange.Delete Shift:=xlToLeft
        Else
        End If
    End With
    
    With Sheets("Cash Flow")
    symbol = Sheets("Final Summary").Range("A" & r)
    url = "URL;https://au.finance.yahoo.com/q/cf?s="
    url = url & symbol & "&annual"
    Sheets("Cash Flow").UsedRange.Delete Shift:=xlToLeft
    End With
        Sheets("Cash Flow").Activate
        With Sheets("Cash Flow").QueryTables.Add(Connection:= _
        url, Destination:=Range("$A$1"))
        .Name = "cf?s=TLS.AX&annual"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "8"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        Application.Wait (Now + TimeValue("0:00:02"))
        Sheets("Final Summary").Range("F" & r) = Sheets("Cash Flow").Range("C12")
        Sheets("Final Summary").Range("G" & r) = Sheets("Cash Flow").Range("C15")
        If r <> lastRow Then
           Sheets("Cash Flow").UsedRange.Delete Shift:=xlToLeft
        Else
        End If
    End With
    
    With Sheets("Analyst Estimates")
    symbol = Sheets("Final Summary").Range("A" & r)
    url = "URL;https://au.finance.yahoo.com/q/ae?s="
    url = url & symbol & "&annual"
    Sheets("Analyst Estimates").UsedRange.Delete Shift:=xlToLeft
    End With
        Sheets("Analyst Estimates").Activate
        With Sheets("Analyst Estimates").QueryTables.Add(Connection:= _
        url, Destination:=Range("$A$1"))
        .Name = "ae?s=CAT.AX"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "8,11,14,17,20,23"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        Application.Wait (Now + TimeValue("0:00:02"))
        Sheets("Final Summary").Range("J" & r) = Sheets("Analyst Estimates").Range("B41")
        If r <> lastRow Then
           Sheets("Analyst Estimates").UsedRange.Delete Shift:=xlToLeft
        Else
        End If
    End With
    
    With Sheets("Key Statistics")
    symbol = Sheets("Final Summary").Range("A" & r)
    url = "URL;https://au.finance.yahoo.com/q/ks?s="
    url = url & symbol
    Sheets("Key Statistics").UsedRange.Delete Shift:=xlToLeft
    End With
        Sheets("Key Statistics").Activate
        With Sheets("Key Statistics").QueryTables.Add(Connection:= _
        url, Destination:=Range("$A$1"))
        .Name = "ks?s=TLS.AX_2"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "7,9,10,12,14,16,18,20,22,26,28,30"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        Application.Wait (Now + TimeValue("0:00:02"))
        Sheets("Final Summary").Range("H" & r) = Sheets("Key Statistics").Range("B61")
        Sheets("Final Summary").Range("I" & r) = Sheets("Key Statistics").Range("B25")
        Sheets("Final Summary").Range("K" & r) = Sheets("Key Statistics").Range("B40")
        Sheets("Final Summary").Range("L" & r) = Sheets("Key Statistics").Range("B21")
        Sheets("Final Summary").Range("M" & r) = Sheets("Key Statistics").Range("B6")
         If r <> lastRow Then
           Sheets("Key Statistics").UsedRange.Delete Shift:=xlToLeft
        Else
        End If
    End With
        pctComp = (r / lastRow)
Application.StatusBar = "Percent Completed: " & Format(pctComp, "000.00%")
Next r

    Sheets("Final Summary").Activate
    UsedRange.Select
    Selection.HorizontalAlignment = xlCenter
    Range("A1").Select
    
Application.ScreenUpdating = True
Application.StatusBar = False

End Sub
 
Upvote 0
That is perfect, thankyou so much!

Can you tell me how I can get the current sale price into the summary page? At the moment the macro pulls the table, however the current sale price isn't included.

For example, i need the larger figure of 5.27 for this company:
https://au.finance.yahoo.com/q?s=TLS.AX

Also, are you located in Australia and / or interested in investing in stocks? I would love to share the purpose of this spreadsheet with you once I have finished with all the internal calcs.
Thanks again!:)
 
Upvote 0
When I did this, I did it on excel 2013 and smart tags are no longer available, I think it stopped with excel 2010. There is not an option to import that figure using the web query. If you are using excel 2003 to excel 2010, then I think you may have to insert another page called smart tags and you would have to use the smart tag option and import that to the smart tag sheet. Also, on the link you gave I noticed it had open: 5.26 and ask:5.28. You could just average those two values. However, I am not sure it would always be like that for every stock. I'll see if I can come up with a solution later today.
 
Upvote 0
Here is a fix that I tried. Let me know if it works. You will need to add another sheet called "Current Price". I will show you that sheet with the formulas followed by the corrected macro, and how you need to set up the sheet "final summary".

Current Price Sheet:

Excel 2012
ABCD
1TLS.AX"TELSTRA FPO"5.27
2
Current Price
Cell Formulas
RangeFormula
B1=WEBSERVICE("http://finance.yahoo.com/d/quotes.csv?s="&A1&"&f=n")
C1=NUMBERVALUE(WEBSERVICE("http://finance.yahoo.com/d/quotes.csv?s="&A1&"&f=l1"))


Macro:
Code: 
Sub DynamicURL()
Dim lastRow As Long, r As Long
Dim url As String
Dim symbol As String

lastRow = Sheets("Final Summary").Range("A" & Rows.Count).End(xlUp).Row
If lastRow = Rows.Count Then Exit Sub
Application.ScreenUpdating = False
Application.StatusBar = False

For r = 2 To lastRow
    Sheets("Current Price").Activate
    With Sheets("Current Price")
    symbol = Sheets("Final Summary").Range("A" & r)
    Sheets("Current Price").Range("A1") = symbol
    Sheets("Final Summary").Range("B" & r) = Sheets("Current Price").Range("C1")
    End With
    
    Sheets("Summary").Activate
    With Sheets("Summary")
    symbol = Sheets("Final Summary").Range("A" & r)
    url = "URL;https://au.finance.yahoo.com/q?s="
    url = url & symbol
    Sheets("Summary").UsedRange.Delete Shift:=xlToLeft
    End With
        With Sheets("Summary").QueryTables.Add(Connection:= _
        url, Destination:=Range("$A$1"))
        .Name = "q?s=TLS.AX_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = """table1"",""table2"""
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        Application.Wait (Now + TimeValue("0:00:02"))
        Sheets("Final Summary").Range("C" & r) = Sheets("Summary").Range("B9")
        Sheets("Final Summary").Range("D" & r) = Sheets("Summary").Range("B13")
        If r <> lastRow Then
           Sheets("Summary").UsedRange.Delete Shift:=xlToLeft
        Else
        End If
    End With
    
    With Sheets("Balance Sheet")
    symbol = Sheets("Final Summary").Range("A" & r)
    url = "URL;https://au.finance.yahoo.com/q/bs?s="
    url = url & symbol
    Sheets("Balance Sheet").UsedRange.Delete Shift:=xlToLeft
    End With
        Sheets("Balance Sheet").Activate
        With Sheets("Balance Sheet").QueryTables.Add(Connection:= _
        url, Destination:=Range("$A$1"))
        .Name = "bs?s=TLS.AX"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "9"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        Application.Wait (Now + TimeValue("0:00:02"))
        Sheets("Final Summary").Range("E" & r) = Sheets("Balance Sheet").Range("C5")
        Sheets("Final Summary").Range("F" & r) = Sheets("Balance Sheet").Range("C6")
        If r <> lastRow Then
           Sheets("Balance Sheet").UsedRange.Delete Shift:=xlToLeft
        Else
        End If
    End With
    
    With Sheets("Cash Flow")
    symbol = Sheets("Final Summary").Range("A" & r)
    url = "URL;https://au.finance.yahoo.com/q/cf?s="
    url = url & symbol & "&annual"
    Sheets("Cash Flow").UsedRange.Delete Shift:=xlToLeft
    End With
        Sheets("Cash Flow").Activate
        With Sheets("Cash Flow").QueryTables.Add(Connection:= _
        url, Destination:=Range("$A$1"))
        .Name = "cf?s=TLS.AX&annual"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "8"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        Application.Wait (Now + TimeValue("0:00:02"))
        Sheets("Final Summary").Range("G" & r) = Sheets("Cash Flow").Range("C12")
        Sheets("Final Summary").Range("H" & r) = Sheets("Cash Flow").Range("C15")
        If r <> lastRow Then
           Sheets("Cash Flow").UsedRange.Delete Shift:=xlToLeft
        Else
        End If
    End With
    
    With Sheets("Analyst Estimates")
    symbol = Sheets("Final Summary").Range("A" & r)
    url = "URL;https://au.finance.yahoo.com/q/ae?s="
    url = url & symbol & "&annual"
    Sheets("Analyst Estimates").UsedRange.Delete Shift:=xlToLeft
    End With
        Sheets("Analyst Estimates").Activate
        With Sheets("Analyst Estimates").QueryTables.Add(Connection:= _
        url, Destination:=Range("$A$1"))
        .Name = "ae?s=CAT.AX"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "8,11,14,17,20,23"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        Application.Wait (Now + TimeValue("0:00:02"))
        Sheets("Final Summary").Range("K" & r) = Sheets("Analyst Estimates").Range("B41")
        If r <> lastRow Then
           Sheets("Analyst Estimates").UsedRange.Delete Shift:=xlToLeft
        Else
        End If
    End With
    
    With Sheets("Key Statistics")
    symbol = Sheets("Final Summary").Range("A" & r)
    url = "URL;https://au.finance.yahoo.com/q/ks?s="
    url = url & symbol
    Sheets("Key Statistics").UsedRange.Delete Shift:=xlToLeft
    End With
        Sheets("Key Statistics").Activate
        With Sheets("Key Statistics").QueryTables.Add(Connection:= _
        url, Destination:=Range("$A$1"))
        .Name = "ks?s=TLS.AX_2"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "7,9,10,12,14,16,18,20,22,26,28,30"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        Application.Wait (Now + TimeValue("0:00:02"))
        Sheets("Final Summary").Range("I" & r) = Sheets("Key Statistics").Range("B61")
        Sheets("Final Summary").Range("J" & r) = Sheets("Key Statistics").Range("B25")
        Sheets("Final Summary").Range("L" & r) = Sheets("Key Statistics").Range("B40")
        Sheets("Final Summary").Range("M" & r) = Sheets("Key Statistics").Range("B21")
        Sheets("Final Summary").Range("N" & r) = Sheets("Key Statistics").Range("B6")
         If r <> lastRow Then
           Sheets("Key Statistics").UsedRange.Delete Shift:=xlToLeft
        Else
        End If
    End With
        pctComp = (r / lastRow)
Application.StatusBar = "Percent Completed: " & Format(pctComp, "000.00%")
Next r

    Sheets("Final Summary").Activate
    UsedRange.Select
    Selection.HorizontalAlignment = xlCenter
    Range("A1").Select
    
Application.ScreenUpdating = True
Application.StatusBar = False

End Sub

Final Summary Sheet:

Excel 2012
ABCDEFGHIJKLMN
1CompanyCurrent Sale PriceShare PriceMarket CapCash & Cash EquivalentsCash Short Term InvestmentsCash Operating ActivitiesCapital ExpendituresShares OutstandingReturn on EquityRevenue Growth RateTotal DebtOperating Profit MarginForward PE Ratio
21PG.AX
3ONT.AX
41ST.AX
5TGP.AX
6TIX.AX
7TOF.AX
Final Summary
 
Upvote 0
Sorry, forgot to add one line to the macro. Here is the corrected macro:

Code: 
Sub DynamicURL()
Dim lastRow As Long, r As Long
Dim url As String
Dim symbol As String

lastRow = Sheets("Final Summary").Range("A" & Rows.Count).End(xlUp).Row
If lastRow = Rows.Count Then Exit Sub
Application.ScreenUpdating = False
Application.StatusBar = False

For r = 2 To lastRow
    Sheets("Current Price").Activate
    With Sheets("Current Price")
    symbol = Sheets("Final Summary").Range("A" & r)
    Sheets("Current Price").Range("A1") = symbol
    Application.Wait (Now + TimeValue("0:00:02"))
    Sheets("Final Summary").Range("B" & r) = Sheets("Current Price").Range("C1")
    End With
    
    Sheets("Summary").Activate
    With Sheets("Summary")
    symbol = Sheets("Final Summary").Range("A" & r)
    url = "URL;https://au.finance.yahoo.com/q?s="
    url = url & symbol
    Sheets("Summary").UsedRange.Delete Shift:=xlToLeft
    End With
        With Sheets("Summary").QueryTables.Add(Connection:= _
        url, Destination:=Range("$A$1"))
        .Name = "q?s=TLS.AX_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = """table1"",""table2"""
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        Application.Wait (Now + TimeValue("0:00:02"))
        Sheets("Final Summary").Range("C" & r) = Sheets("Summary").Range("B9")
        Sheets("Final Summary").Range("D" & r) = Sheets("Summary").Range("B13")
        If r <> lastRow Then
           Sheets("Summary").UsedRange.Delete Shift:=xlToLeft
        Else
        End If
    End With
    
    With Sheets("Balance Sheet")
    symbol = Sheets("Final Summary").Range("A" & r)
    url = "URL;https://au.finance.yahoo.com/q/bs?s="
    url = url & symbol
    Sheets("Balance Sheet").UsedRange.Delete Shift:=xlToLeft
    End With
        Sheets("Balance Sheet").Activate
        With Sheets("Balance Sheet").QueryTables.Add(Connection:= _
        url, Destination:=Range("$A$1"))
        .Name = "bs?s=TLS.AX"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "9"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        Application.Wait (Now + TimeValue("0:00:02"))
        Sheets("Final Summary").Range("E" & r) = Sheets("Balance Sheet").Range("C5")
        Sheets("Final Summary").Range("F" & r) = Sheets("Balance Sheet").Range("C6")
        If r <> lastRow Then
           Sheets("Balance Sheet").UsedRange.Delete Shift:=xlToLeft
        Else
        End If
    End With
    
    With Sheets("Cash Flow")
    symbol = Sheets("Final Summary").Range("A" & r)
    url = "URL;https://au.finance.yahoo.com/q/cf?s="
    url = url & symbol & "&annual"
    Sheets("Cash Flow").UsedRange.Delete Shift:=xlToLeft
    End With
        Sheets("Cash Flow").Activate
        With Sheets("Cash Flow").QueryTables.Add(Connection:= _
        url, Destination:=Range("$A$1"))
        .Name = "cf?s=TLS.AX&annual"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "8"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        Application.Wait (Now + TimeValue("0:00:02"))
        Sheets("Final Summary").Range("G" & r) = Sheets("Cash Flow").Range("C12")
        Sheets("Final Summary").Range("H" & r) = Sheets("Cash Flow").Range("C15")
        If r <> lastRow Then
           Sheets("Cash Flow").UsedRange.Delete Shift:=xlToLeft
        Else
        End If
    End With
    
    With Sheets("Analyst Estimates")
    symbol = Sheets("Final Summary").Range("A" & r)
    url = "URL;https://au.finance.yahoo.com/q/ae?s="
    url = url & symbol & "&annual"
    Sheets("Analyst Estimates").UsedRange.Delete Shift:=xlToLeft
    End With
        Sheets("Analyst Estimates").Activate
        With Sheets("Analyst Estimates").QueryTables.Add(Connection:= _
        url, Destination:=Range("$A$1"))
        .Name = "ae?s=CAT.AX"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "8,11,14,17,20,23"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        Application.Wait (Now + TimeValue("0:00:02"))
        Sheets("Final Summary").Range("K" & r) = Sheets("Analyst Estimates").Range("B41")
        If r <> lastRow Then
           Sheets("Analyst Estimates").UsedRange.Delete Shift:=xlToLeft
        Else
        End If
    End With
    
    With Sheets("Key Statistics")
    symbol = Sheets("Final Summary").Range("A" & r)
    url = "URL;https://au.finance.yahoo.com/q/ks?s="
    url = url & symbol
    Sheets("Key Statistics").UsedRange.Delete Shift:=xlToLeft
    End With
        Sheets("Key Statistics").Activate
        With Sheets("Key Statistics").QueryTables.Add(Connection:= _
        url, Destination:=Range("$A$1"))
        .Name = "ks?s=TLS.AX_2"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "7,9,10,12,14,16,18,20,22,26,28,30"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        Application.Wait (Now + TimeValue("0:00:02"))
        Sheets("Final Summary").Range("I" & r) = Sheets("Key Statistics").Range("B61")
        Sheets("Final Summary").Range("J" & r) = Sheets("Key Statistics").Range("B25")
        Sheets("Final Summary").Range("L" & r) = Sheets("Key Statistics").Range("B40")
        Sheets("Final Summary").Range("M" & r) = Sheets("Key Statistics").Range("B21")
        Sheets("Final Summary").Range("N" & r) = Sheets("Key Statistics").Range("B6")
         If r <> lastRow Then
           Sheets("Key Statistics").UsedRange.Delete Shift:=xlToLeft
        Else
        End If
    End With
        pctComp = (r / lastRow)
Application.StatusBar = "Percent Completed: " & Format(pctComp, "000.00%")
Next r

    Sheets("Final Summary").Activate
    UsedRange.Select
    Selection.HorizontalAlignment = xlCenter
    Range("A1").Select
    
Application.ScreenUpdating = True
Application.StatusBar = False

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Solved
Excel 2016 VBA - Pull data from multiple sheets to One with specificities
Replies
3
Views
251
mumps
mumps
J
  • Question Question
Power Query editor OR VBA to extract data from Grants.gov
Replies
3
Views
294
Jagadeshrao
J
A
  • Question Question
Macro to Combine Data from Multiple Sheets
Replies
2
Views
345
ashringg
A
B
  • Solved
using vba excel to unpivot with multiple categories (1 w/ 4 columns & 1 w/ 5 columns) of data
2
Replies
13
Views
1K
Fluff
Fluff
S
  • Solved
Seperate Data In One Cell Across Multiple Cells
Replies
6
Views
2K
Alex Blakenburg
A

Forum statistics

Threads
1,223,246
Messages
6,170,999
Members
452,373
Latest member
TimReeks

Share this page

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