Changing a loop and finding a HREF links using VBA and appending fetched links from sheet

[mattadams84]

Hi all,

My problem is two-fold. I have a worksheet already created that has a list of Football Leagues (in the rows), the columns hold the data. I have some code that fetches data from a website and populates this sheet (each row contains data corresponding to a league). It currently works, but i need to modify it so that it acts slightly differently.

'VBE > Tools > References:'1: Microsoft HTML Object library  2: Microsoft Internet Controls
Public Sub GetSoccerStats()
    Dim ie As Object, t As Date
    Dim objDoc As New MSHTML.HTMLDocument, text As String
    Dim lastRow As Long, dataSheet As Worksheet, inputArray(), i As Long


    Const MAX_WAIT_SEC As Long = 10


    Set dataSheet = ThisWorkbook.Worksheets("AVG GOAL DATA")
    Set ie = CreateObject("InternetExplorer.Application")
    With dataSheet
        lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    End With


    inputArray = dataSheet.Range("C4:E" & lastRow).Value
    inputArray = GetLinks(inputArray)


    Dim results(), r As Long, c As Long
    ReDim results(1 To UBound(inputArray, 1), 1 To 8)


    With ie
        .Visible = True
        For i = LBound(inputArray, 1) To UBound(inputArray, 1)
            r = r + 1
            .navigate2 inputArray(i, 4)


            While .Busy Or .readyState < 4: DoEvents: Wend


            Dim objTable As MSHTML.HTMLTable, objTableRow As MSHTML.HTMLTableRow


            Do
                DoEvents
                On Error Resume Next
                Set objTable = .document.getElementsByClassName("table-main leaguestats")(0)
                On Error GoTo 0
                If Timer - t > MAX_WAIT_SEC Then Exit Do
            Loop While objTable Is Nothing


            If Not objTable Is Nothing Then
                c = 1
                For Each objTableRow In objTable.Rows
                    text = objTableRow.Cells(0).innerText
                    Select Case text
                    Case "Matches played", "Matches remaining", "Home goals", "Away goals"
                        results(r, c) = objTableRow.Cells(1).innerText
                        results(r, c + 1) = objTableRow.Cells(2).innerText
                        c = c + 2
                    End Select
                Next objTableRow
            End If
        Next
        .Quit
    End With
    dataSheet.Range("F4").Resize(UBound(results, 1), UBound(results, 2)) = results
End Sub

The problem is in the next section of code which is the part that fetches the URL links from my spreadsheet.

Public Function GetLinks(ByRef inputArray As Variant) As Variant    Dim i As Long
    ReDim Preserve inputArray(1 To UBound(inputArray, 1), 1 To UBound(inputArray, 2) + 1)


    For i = LBound(inputArray, 1) To UBound(inputArray, 1)
        inputArray(i, 4) = IIf(inputArray(i, 1) = "CURRENT", inputArray(i, 2), inputArray(i, 3))
    Next
    GetLinks = inputArray
End Function

At the moment this code looks on my sheet to see that if in column C, the word is CURRENT, then use the URL provided in column D. If it doesn't contain that word it takes the URL from column E.

So my first problem is that I need change it so that if it the cell DOES NOT contain the word CURRENT it simply skips the row (or that league) and goes to the next row down and repeats the process. This is because the data i am fetching does not change in the URL for column E, so there is no need to refetch it.

My second problem is that Some leagues towards the end of the season get split in to groups (See betexplorer.com/soccer/…) As you notice when you land on this page it defaults you to giving stats to the 'Championship group' However there is a tab that says 'main'. This is the data i need. The further problem is that not all leagues have this. As far as i can tell, the 'main' stats tab has a different URL within an HREF tag so perhaps the VBA can use the link i provide on the worksheet, check to see if a 'main' tab exists, if it does not then just pull the data from that page, or if it does then redirect to the URL for the 'main' tab and pull the data from that one...

Can anyone help?

Here is a link to my spreadsheet :

https://www.dropbox.com/s/oumlev7guu5ru5h/Goals.xlsm?dl=0

 

[Norie]

The problem isn't really in the loop, it's in the GetLinks function.

For a start in that function the variable SelectedButton is empty.

Do you actually need the function?

Can't you incorporate the check for the value in column C into the main code?