Making code more concise - VBA scrape information

[hugo08642]

Hi everyone,

I am hoping that someone can help me make this more concise.... maybe a loop is appropriate but I am not very good with this kind of thing.

I have hundreds of stocks that each have their own sheet on a workbook.

I want relevant information from a website to go to a specific row in a specific worksheet.

The following VBA code works well and achieves the above goals, but as you can imagine, this is a time consuming approach. Any help would be much appreciated.

All required variables for the below code have been established in the option explicit section.


Sub Overviewandfinancialsseventh50()
Set ch = New selenium.ChromeDriver
Set ks = New selenium.Keys
Set ws301 = ThisWorkbook.Worksheets("AGY")
Set ws302 = ThisWorkbook.Worksheets("TUA")
Set ws303 = ThisWorkbook.Worksheets("CBO")
Set ws304 = ThisWorkbook.Worksheets("COE")
Set ws305 = ThisWorkbook.Worksheets("SM1")
Set ws306 = ThisWorkbook.Worksheets("SIQ")
Set ws307 = ThisWorkbook.Worksheets("OFX")
Set ws308 = ThisWorkbook.Worksheets("SHV")
Set ws309 = ThisWorkbook.Worksheets("WGB")
Set ws310 = ThisWorkbook.Worksheets("PBH")
Set ws311 = ThisWorkbook.Worksheets("SBM")
Set ws312 = ThisWorkbook.Worksheets("SLX")
Set ws313 = ThisWorkbook.Worksheets("LLL")
Set ws314 = ThisWorkbook.Worksheets("WHF")
Set ws315 = ThisWorkbook.Worksheets("NBI")
Set ws316 = ThisWorkbook.Worksheets("DYL")
Set ws317 = ThisWorkbook.Worksheets("BCB")
Set ws318 = ThisWorkbook.Worksheets("MAD")
Set ws319 = ThisWorkbook.Worksheets("HPI")
Set ws320 = ThisWorkbook.Worksheets("OCA")
Set ws321 = ThisWorkbook.Worksheets("IDX")
Set ws322 = ThisWorkbook.Worksheets("NMT")
Set ws323 = ThisWorkbook.Worksheets("URW")
Set ws324 = ThisWorkbook.Worksheets("PFP")
Set ws325 = ThisWorkbook.Worksheets("ECX")
Set ws326 = ThisWorkbook.Worksheets("AEF")
Set ws327 = ThisWorkbook.Worksheets("RMS")
Set ws328 = ThisWorkbook.Worksheets("HM1")
Set ws329 = ThisWorkbook.Worksheets("AD8")
Set ws330 = ThisWorkbook.Worksheets("JHG")
Set ws331 = ThisWorkbook.Worksheets("MIR")
Set ws332 = ThisWorkbook.Worksheets("OPH")
Set ws333 = ThisWorkbook.Worksheets("ABB")
Set ws334 = ThisWorkbook.Worksheets("PPC")
Set ws335 = ThisWorkbook.Worksheets("AQZ")
Set ws336 = ThisWorkbook.Worksheets("REG")
Set ws337 = ThisWorkbook.Worksheets("EHE")
Set ws338 = ThisWorkbook.Worksheets("STA")
Set ws339 = ThisWorkbook.Worksheets("VG1")
Set ws340 = ThisWorkbook.Worksheets("GWA")
Set ws341 = ThisWorkbook.Worksheets("CTT")
Set ws342 = ThisWorkbook.Worksheets("STX")
Set ws343 = ThisWorkbook.Worksheets("MYR")
Set ws344 = ThisWorkbook.Worksheets("MYX")
Set ws345 = ThisWorkbook.Worksheets("ARU")
Set ws346 = ThisWorkbook.Worksheets("MGX")
Set ws347 = ThisWorkbook.Worksheets("FGX")
Set ws348 = ThisWorkbook.Worksheets("PWR")
Set ws349 = ThisWorkbook.Worksheets("OPT")
Set ws350 = ThisWorkbook.Worksheets("PGH")
Ticker301 = "AGY"
Ticker302 = "TUA"
Ticker303 = "CBO"
Ticker304 = "COE"
Ticker305 = "SM1"
Ticker306 = "SIQ"
Ticker307 = "OFX"
Ticker308 = "SHV"
Ticker309 = "WGB"
Ticker310 = "PBH"
Ticker311 = "SBM"
Ticker312 = "SLX"
Ticker313 = "LLL"
Ticker314 = "WHF"
Ticker315 = "NBI"
Ticker316 = "DYL"
Ticker317 = "BCB"
Ticker318 = "MAD"
Ticker319 = "HPI"
Ticker320 = "OCA"
Ticker321 = "IDX"
Ticker322 = "NMT"
Ticker323 = "URW"
Ticker324 = "PFP"
Ticker325 = "ECX"
Ticker326 = "AEF"
Ticker327 = "RMS"
Ticker328 = "HM1"
Ticker329 = "AD8"
Ticker330 = "JHG"
Ticker331 = "MIR"
Ticker332 = "OPH"
Ticker333 = "ABB"
Ticker334 = "PPC"
Ticker335 = "AQZ"
Ticker336 = "REG"
Ticker337 = "EHE"
Ticker338 = "STA"
Ticker339 = "VG1"
Ticker340 = "GWA"
Ticker341 = "CTT"
Ticker342 = "STX"
Ticker343 = "MYR"
Ticker344 = "MYX"
Ticker345 = "ARU"
Ticker346 = "MGX"
Ticker347 = "FGX"
Ticker348 = "PWR"
Ticker349 = "OPT"
Ticker350 = "PGH"
ch.Timeouts.ImplicitWait = 10000
ch.Start baseUrl:="website url"
ch.Get "/"
ch.Wait 15000
ch.Get "/login"
ch.Wait 15000
ch.FindElementByName("email").SendKeys "login info"
ch.FindElementByName("password").SendKeys "login info"
ch.FindElementByName("password").submit
ch.Get "/asx/" & Ticker301 & ""
ch.Wait 15000
Set Overviews = ch.FindElementsByClass("mt-8")
For Each Overview In Overviews
Set tbls = ch.FindElementsByCss("tbody")
For Each t In tbls
t.AsTable.ToExcel ws301.Range("R1048576").End(xlUp).Offset(1, 0)
Next t
Next Overview
ws301.Range("R1").Value = Ticker301
ch.Get "/asx/" & Ticker302 & ""
ch.Wait 15000
Set Overviews = ch.FindElementsByClass("mt-8")
For Each Overview In Overviews
Set tbls = ch.FindElementsByCss("tbody")
For Each t In tbls
t.AsTable.ToExcel ws302.Range("R1048576").End(xlUp).Offset(1, 0)
Next t
Next Overview
ws302.Range("R1").Value = Ticker302
ch.Get "/asx/" & Ticker303 & ""
ch.Wait 15000
Set Overviews = ch.FindElementsByClass("mt-8")
For Each Overview In Overviews
Set tbls = ch.FindElementsByCss("tbody")
For Each t In tbls
t.AsTable.ToExcel ws303.Range("R1048576").End(xlUp).Offset(1, 0)
Next t
Next Overview
ws303.Range("R1").Value = Ticker303

[SamT]

While I don't underst6and exactly what you are doing, I notice that you are repeating the code for every single string (ticker name) in a list (Array) of Ticker Names.


Dim Tickers As Variant
Tickers = Array("ABC", "CDE", "EFG", Etc)
'Alternativly
'Tickers = Sheets("ABC").Range("A1").CurrentRegion.Value
For i = LBound(Tickers) to UBound(Tickers)
(Call) ACX Tickers(i)
(Call)DoOverview WorkSheets(Tickers(i))
(Call) next subsdiary Procedure needed by a Stock
Next i
End Sub


Sub ACX(Ticker)
ch.Get "/asx/" & Ticker & ""
ch.Wait 15000
End Sub

Sub DoOverview(Sht As WorkSheet)
'What ever. I'm making stuff up as I go to demo one array of Names, pass the Names to Subs as needed

t.AsTable.ToExcel Sht.Cells(Rows.Count, "R").End(xlUp).Offset(1, 0) 'Note no Magic number
Next t
End Sub


Sub YetAnotherExample(X As Z)
'With this many Loops within Loops, I would pass the inner loop to another SubSub
For Each X in W
(Calling) SubSub X
Next
End Sub
SubSub(ByRef X)
X = Z
End Sub


By placing every Action in it's own Procedure, It is very easy to understand each Action Procedure and to pin point any errors or mistakes.

The use of the best names withing Procedures is very important to understanding the Procedure. I typically spend as much actual time concerned over good Names as I do on Coding. For example, Instead of passing a Tickers(i) or a Named Sheet to Subs, use something like

TickerName = Tickers(i)
SubWhatever TickerName
End SubThis makes it clear, within the sub procedure, that you are applying that Name (String) to a Sheet, Range, Web Call, or whatever.

[p45cal]

Set up a sheet, let's call it Control (and hide it if you want).
It contains a proper Excel table called Tickers. I suggest a proper Excel table because it adjusts its size automatically according to the number of entries and the vba code won't need to change.
In it, list your symbols in a column headed Ticker (and your numbers in another column if you want but that's not necessary for this).
This makes it easy for you to add/change tickers without needing to go into the code.
For every ticker symbol in that table there needs to be a corresponding sheet of the same name.
Then run the following code:
Sub Overviewandfinancialsseventh50()
Set ch = New selenium.ChromeDriver
Set ks = New selenium.Keys
ch.Timeouts.ImplicitWait = 10000
ch.Start baseUrl:="website url"
ch.Get "/"
ch.Wait 15000
ch.Get "/login"
ch.Wait 15000
ch.FindElementByName("email").SendKeys "login info"
ch.FindElementByName("password").SendKeys "login info"
ch.FindElementByName("password").submit
Tickers = Sheets("Control").ListObjects("Tickers").ListColumns("Ticker").DataBodyRange.Value

For Each Ticker In Tickers
Set ws = ThisWorkbook.Worksheets(Ticker)
ch.Get "/asx/" & Ticker & ""
ch.Wait 15000
Set Overviews = ch.FindElementsByClass("mt-8")
For Each Overview In Overviews
Set tbls = ch.FindElementsByCss("tbody")
For Each t In tbls
t.AsTable.ToExcel ws.Range("R1048576").End(xlUp).Offset(1, 0)
Next t
Next Overview
ws.Range("R1").Value = Ticker
Next Ticker
End Sub

That's it.
I can't test it, for obvious reasons.

[hugo08642]

Wow, so simple and saves so much time!
Thanks so much p45cal.

I don't suppose you could help me out with another......

I am now copying the financials into various sheets (comparable companies) to help with analysis.

Currently the code looks like this (all required variables have been set in this sub, just showing the repetitive portion of the code):



Sub Peerfinancials()

Sheets("TLX").Select
Range("AB1:AL250").Select
Selection.Copy
Sheets("CSL").Select
Range("AN1").Select
ActiveSheet.Paste
Sheets("IMU").Select
Range("AB1:AL250").Select
Selection.Copy
Sheets("CSL").Select
Range("AZ1").Select
ActiveSheet.Paste
Sheets("CUV").Select
Range("AB1:AL250").Select
Selection.Copy
Sheets("CSL").Select
Range("BL1").Select
ActiveSheet.Paste
Sheets("MSB").Select
Range("AB1:AL250").Select
Selection.Copy
Sheets("CSL").Select
Range("BX1").Select
ActiveSheet.Paste

End Sub

Again, quite time consuming.

Is it possible to utilise a control sheet, with relevant companies for a sector, and select the four closest companies based off market cap, then use a similar nested loop approach?

I have an idea based off your previous advice, but my trouble is selecting off closest market cap both above and below the current ticker in the control sheet.

Ideally, the data would be placed in the following order:

Largest competitor - range AN1
Second largest competitor - range AZ1
Third largest competitor - range BL1
Fourth largest competitor - range BX1


The available data would be:



Number
Ticker
Market Cap


1
BHP
200B


2
RIO
34.37B


3
S32
17.86B


4
PLS
17.54B


5
MIN
14B


6
IGO
12B


7
AKE
9B


8
LYC
7B


9
LTR
5B



For example, in sheet(S32) the competitor information would be:

Largest competitor - range AN1 - PLS
Second largest competitor - range AZ1 - MIN
Third largest competitor - range BL1 - IGO
Fourth largest competitor - range BX1 - AKE


Whilst, in sheet(MIN) the competitor information would be:

Largest competitor - range AN1 - S32
Second largest competitor - range AZ1 - PLS
Third largest competitor - range BL1 - IGO
Fourth largest competitor - range BX1 - AKE

[p45cal]

For your code and its condensation, you could try:
Sub Peerfinancials()
Set Destn = Sheets("CSL").Range("AN1")
For Each sht In Sheets(Array("TLX", "IMU", "CUV", "MSB"))
sht.Range("AB1:AL250").Copy Destn
Set Destn = Destn.Offset(, 12)
Next sht
End SubFor the rest it would be a case of setting the line For Each sht In Sheets(Array("TLX", "IMU", "CUV", "MSB")) to contain only the 4 competitors in order, but that's more complicated and warrants you posting a new thread with more details and crucially some realistic sample data in a workbook, and if you think it useful, include a link to this thread.