Advanced: VBA - Click button on Website, copy output from CSV and Paste Contents to Excel

Scott123_xyz

New Member
Joined
Jan 19, 2020
Messages
2
Office Version
  1. 365
Platform
  1. Windows
I am a novice in vba and am starting to learn a few things, but i'm stumped on how to do the following:
Essentially, I have a workbook that contains a list of stocks (range a8 to a200) on a worksheet called "summary". Each stock in the list has its own worksheet and I want to download financial data for each stock and store it in the corresponding worksheet. following is a specific example:
The workbook is titled: StockData
The worksheet is titled: RY.Xtse

The appropriate URL is stored in range("b3") of each worksheet. For this worksheet the url is as follows: Growth, Profitability, and Financial Ratios for Royal Bank of Canada (RY) from Morningstar.com
Here's the challenge: I want to start with the first stock on the list from my summary worksheet. Then I want to go its respective stock sheet (see sample above) and open the URL indicated in range b3 of the worksheet (see sample indicated above), click on the export button from the webpage which creates a CSV file. Once the CSV file opens, i want to copy (range a1: L11) from the CSV file and paste it in range ("a10") of the respective stock worksheet. Then I want to close the CSV file and go to the next worksheet on the list from my summary worksheet, and repeat the process for that stock until all stocks in the list from my "summary" worksheet has had their respective info saved. I have approx. 200 stocks I want to do this for every month
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
All stocks I would think do not have the same interface...? This would be extremely involved...
 
Upvote 0
I have manually saved the url on each stocksheet in cell b3 of each stocksheet
 
Upvote 0
Yes but the automation you are asking for would require extensive testing to match with the coding of each web page unless you are doing the export manually?
 
Upvote 0
Hi Scott123_xyz, always looking for challenges, I thought this might be a nice one. It seems to me that this is what you're looking for: video on WeTransfer
Please let me know, since some explanation on the code may be needed.
 
Upvote 0
Since I'll be offline for a while my code is below. The Sub Public Sub SwitchToSheetAndFireURL() is doing the job. When you're able to place a FormButton on your Summary Worksheet, you can link this button to this Sub, otherwise you can launch this Sub from within VBE.
Requirements / Explanation:
  • The Sub SwitchToSheetAndFireURL depends on the selected cell on your Summary sheet. This cell must contain a value (i.e. text) equal to the name of an existing worksheet in your workbook, as mentioned by you in your post #1. When such a sheet does not exist, nothing happens, the code will not crash.
  • When an appropriate URL is found (in cell B3), that URL will be launched (other URL's on that sheet will be ignored). Your browser will open so you're be able to download the desired CSV-file. In the mean time the code keeps track on all Workbooks that will be opened afterwards and checks wether the filename ends with ***.CSV.
  • The moment a CSV file is opened from the Explorer, Excel steps in so the code within your Workbook will place the CSV data on a new worksheet and will copy the desired part (A1:L11) to the worksheet with the name in accordance with the content of the selected cell on the Summary worksheet (provided a file reference in Windows has been made between CSV and Excel).
  • Hereafter this cycle continues untill there are no more adjacent cells in that specific column with a value equal to the name of an existing worksheet. The moment this cycle stops, the code will no longer keep track of the files that will be opened in Excel.
I've incorporated your requirements regarding source sheet Cells and destination sheet Cells in such a way, that you're be able to change it easily if desired (see attached image).

GWteB_12.jpg


Ragarding my code there are two modules involved, a regular module and a class module. Required actions within the VBE:
  1. Menu > Insert > Class Module;
  2. click on the new inserted class module in the left hand Project pane (if there is no Project pane press CTRL R) and rename that module in "class_xLEvents" using the left hand Properties pane (if there is no Properties pane press F4);
  3. double click on the new inserted module "class_xLEvents" and paste the appropriate code in the right hand pane;
  4. Menu > Insert > Module;
  5. double click in the left hand Project pane on the new inserted module;
  6. click in the right hand pane and paste the appropriate code;
  7. Menu > Debugging > Compile VBAProject
Finally save your Workbook as an ***.XLSM file (macro's enabled). Enjoy!
 
Upvote 0
class module class_xLEvents
VBA Code:
Public WithEvents MyAppEvent As Application
'
Private Sub MyAppEvent_WorkbookOpen(ByVal Wb As Workbook)
    If StrComp(GetFileExtension(Wb.FullName), cExtension_CSV, vbTextCompare) = 0 Then
        Call GetStockData(Wb)
    End If
End Sub

regular module
VBA Code:
Option Explicit
'
Public Const cMyHomeSheet           As String = "Summary"
Public Const cExtension_CSV         As String = "csv"
Public Const cMyHyperAddress        As String = "$B$3"
Public Const cDataSourceAddress     As String = "$A$1:$L$11"
Public Const cDataDestAddress       As String = "$A$10"

Dim oXlEvent                        As class_xLEvents
'

Public Sub SwitchToSheetAndFireURL()    '  <<<<<< MAIN SUB  <<<<
    Dim rngSelect       As Range
    Dim oWs             As Worksheet
    Dim oHl             As Hyperlink
    
    On Error GoTo SUB_ERR
    Set rngSelect = Selection
    With rngSelect
        If .Count = 1 Then
            If StrComp(.Parent.Name, cMyHomeSheet, vbTextCompare) = 0 Then
                On Error Resume Next
                Set oWs = ThisWorkbook.Sheets(.Text)
                On Error GoTo 0
                If Not oWs Is Nothing Then
                    oWs.Select
                    Call CheckOnCSV(True)
                    For Each oHl In oWs.Hyperlinks
                        If oHl.Range.Address = cMyHyperAddress Then
                            On Error Resume Next
                            oHl.Follow
                            On Error GoTo SUB_ERR
                        End If
                    Next oHl
                End If
            End If
        End If
    End With
SUB_EXIT:
    Set oHl = Nothing
    Set oWs = Nothing
    Set rngSelect = Nothing
    Exit Sub
SUB_ERR:
    MsgBox "Something went wrong ...", vbExclamation, "Switching to other Worksheet"
    Err.Clear
    Resume SUB_EXIT
End Sub

Public Sub GetStockData(ByRef argWb As Workbook)

    Dim rngData             As Range
    Dim sCSV_FullFileName   As String
    
    If Not argWb Is Nothing Then
        sCSV_FullFileName = argWb.FullName
        argWb.Close SaveChanges:=False
    End If
    With ActiveSheet
        Set rngData = GetCSVData(sCSV_FullFileName)
        rngData.Copy Destination:=.Range(cDataDestAddress)
    End With

    Application.DisplayAlerts = False
    rngData.Parent.Delete
    Application.DisplayAlerts = True
    Set rngData = Nothing
    Call CheckOnCSV(False)
    With ThisWorkbook.Worksheets(cMyHomeSheet)
        .Select
        Selection.Offset(1, 0).Select
    End With
    Call SwitchToSheetAndFireURL
End Sub

Public Function GetFileExtension(ByRef argFileName As String) As String
    Const cDot      As String = "."
    Dim lLen        As Long
    If Not argFileName = "" Then
        lLen = InStrRev(argFileName, cDot, -1, vbTextCompare)
        If lLen = 0 Then
            GetFileExtension = ""
        Else
            GetFileExtension = Right(argFileName, Len(argFileName) - lLen)
        End If
    End If
End Function

Private Function GetCSVData(ByRef argFullFileName As String) As Range
    Dim oWs     As Worksheet
    Dim sFile   As String

    If Not argFullFileName = "" Then
        sFile = StripFileExtension(StripFilePath(argFullFileName))
        Set oWs = ThisWorkbook.Worksheets.Add
        
        With oWs.QueryTables.Add(Connection:="TEXT;" & argFullFileName, Destination:=Range("$A$1"))
            .Name = sFile
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 1252
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileDecimalSeparator = "."
            .TextFileThousandsSeparator = ","
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
    End If
    Set GetCSVData = oWs.Range(cDataSourceAddress)
End Function


Private Function StripFilePath(ByRef argFullFileName As String) As String
    Dim lLen        As Long
    If Not argFullFileName = "" Then
        lLen = Len(argFullFileName) - InStrRev(argFullFileName, Application.PathSeparator)
        StripFilePath = Right(argFullFileName, lLen)
    End If
End Function

Private Function StripFileExtension(ByRef argFileName As String) As String
    Const cDot  As String = "."
    Dim lLen    As Long
    If Not argFileName = "" Then
        lLen = InStrRev(argFileName, cDot, -1, vbTextCompare)
        If lLen = 0 Then
            StripFileExtension = argFileName
        Else
            lLen = 1 + Len(argFileName) - lLen
            StripFileExtension = Left(argFileName, Len(argFileName) - lLen)
        End If
    End If
End Function

Private Sub CheckOnCSV(ByVal argEnable As Boolean)
    If argEnable Then
        Set oXlEvent = New class_xLEvents
        Set oXlEvent.MyAppEvent = Application
    Else
        Set oXlEvent.MyAppEvent = Nothing
    End If
End Sub
 
Upvote 0

Forum statistics

Threads
1,214,927
Messages
6,122,309
Members
449,080
Latest member
jmsotelo

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