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:


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

<tbody>
</tbody>


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

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Give me a little bit before you try them. I stepped through the macros using f8 and they worked fine, but when running normal, they hang up on a couple of lines. Not sure why. Also, I need to move the percent complete again. I'll repost the last macro once I move the percent complete, step through it, run as normal, and see what happens.
 
Upvote 0
Here is the macro so far. Try this and let me know how it works. It will take a couple hours to run.
Code: 
Sub DynamicURL()
Dim lastRow As Long, r As Long
Dim url As String
Dim symbol As String

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

For r = 2 To lastRow
StartTime = Time
    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("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("J" & r) = Sheets("Key Statistics").Range("B30")
        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
        EndTime = Time
        pctComp = (r / lastRow)
Application.StatusBar = "Percent Completed: " & Format(pctComp, "000.00%") & " Estimated Time Left: " & Format(((EndTime - StartTime) / r - 1) * lastRow, "hh:mm:ss")
Next r

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

End Sub
 
Upvote 0
Here is the macro. Let me know how it does and what else needs to be changed. It will take a while to run. I am guessing two to three hours.
Code: 
Sub DynamicURL()
Dim lastRow As Long, r As Long
Dim url As String
Dim symbol As String

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

For r = 2 To lastRow
StartTime = Time
    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("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("J" & r) = Sheets("Key Statistics").Range("B30")
        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
        EndTime = Time
        pctComp = (r / lastRow)
Application.StatusBar = "Percent Completed: " & Format(pctComp, "000.00%") & " Estimated Time Left: " & Format(((EndTime - StartTime) * lastRow) / r, "hh:mm:ss")
Next r

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

End Sub
 
Upvote 0
Here is the macro with the estimated time remaining removed. I can't figure it out. Use this macro and let me know how if it works like you want.
Code: 
Sub DynamicURL()
Dim lastRow As Long, r As Long
Dim url As String
Dim symbol As String

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

For r = 2 To lastRow
StartTime = Time
    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("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("J" & r) = Sheets("Key Statistics").Range("B30")
        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
        EndTime = Time
        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
I really appreciate all the effort you have put into this Michael!
Unfortunately the place I am visiting in Malaysia has no substantial internet so I will have to wait a week to get it all going. Is there anyway I can repay you for your selfless service?
 
Upvote 0
Hi Michael, managed to have a bit of a play around last night and have noticed a couple of things.
When the macro is ran, an error comes up and it will stop at a random point (first time after 100 companies, then 50, then 900).
Additionally, where the company share price is pulled, it pulls the share price day range instead of the current price.
Aside from these issues its looking perfect as far as I can see. Look forwards to working on it tonight!
:)
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
Macro to Combine Data from Multiple Sheets
Replies
2
Views
175
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
880
Fluff
Fluff
S
  • Solved
Seperate Data In One Cell Across Multiple Cells
Replies
6
Views
1K
Alex Blakenburg
A
C
  • Question
VBA Macros to Copy Specific Cells Values from Multiple Sheets to Specific Cells in Summary Sheets
Replies
2
Views
292
chittunoo
C
T
  • Solved
VBA: sumifs data and calculate score base on multiple criteria in cell value
2 3
Replies
20
Views
2K
mumps
mumps

Forum statistics

Threads
1,215,054
Messages
6,122,893
Members
449,097
Latest member
dbomb1414

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