Web scraping with VBA

Question

I have this code that fetches rates from a website called X-Rates, and outputs to excel the monthly averages of a chosen country.

The code runs quite fast, but I still think there's improvements to be done!

Apologies for long code, but if you help me I would be really grateful!

Option Explicit

Public Sub fetchCurrencyPast()

Dim RowNum As Long
Dim ColNum As Long
Dim RowNumB As Long
Dim ColNumB As Long
Dim i As Long
Dim Period As String
Dim SCrcy As String
Dim MsgErr As String

On Error GoTo ErrHandler

Call FormatResultSheet
Call AddHeader

Period = Application.InputBox("What's the year you want to collect back data?", "Period", , , , , 2)

On Error GoTo ErrHandler

If Len(Period) <> 4 Then
    GoTo ErrHandler
    Exit Sub
End If

Application.ScreenUpdating = False

For i = 1 To 9

    RowNum = 2
    RowNumB = 2
    ColNum = 4
    ColNumB = 3

    If i = 1 Then
        'ARS
        Cells(RowNum, 2).Value = "ARS"
        Cells(RowNum, 1).Value = Period

        For Each SCrcy In Array("EUR", "USD", "GBP")
            Call GetRateYear("ARS", SCrcy, Period, RowNum, ColNum)
            RowNum = 2
            ColNum = ColNum + 1
            RowNumB = RowNum
            Call GetSingleMonth("ARS", SCrcy, Period, RowNumB, ColNumB)
        Next

    End If

    If i = 2 Then
        RowNum = 14
        ColNum = 4
        'AUD
        Cells(RowNum, 2).Value = "AUD"
        Cells(RowNum, 1).Value = Period

        For Each SCrcy In Array("EUR", "USD", "GBP")
            Call GetRateYear("AUD", SCrcy, Period, RowNum, ColNum)
            RowNum = 14
            ColNum = ColNum + 1
            RowNumB = RowNum
            Call GetSingleMonth("AUD", SCrcy, Period, RowNumB, ColNumB)
        Next
    End If

Error Handler:

ErrHandler:

If Err.Number <> 0 Then

    MsgErr = "Error #" & Str(Err.Number) & " was generated by " & Err.Source & "." & Chr(10) & "Error description: " & Err.Description
    MsgBox MsgErr, , "Error", Err.HelpFile, Err.HelpContext
    Exit Sub
End If

End Sub

GetRatesYear Function:

 Private Function GetRateYear(ByVal sFromCrcy As String, ByVal sToCrcy As String, ByVal sYear As String, ByVal RowNum As Long, ByVal ColNum As Long)

'This function sends a XML HTTP request, as is much more faster than waiting for browser to DoEvents
'Usage -> Goes to X-rates website and retrieves the code from conversion

Dim sUrl As String
Dim sContent As String
Dim intMatches As Variant
Dim mtchCnt As Integer
Dim subMtchCnt As Integer


sUrl = "http://www.x-rates.com/average/?from=" & sFromCrcy & "&to=" & sToCrcy & "&amount=1&year=" & sYear

'XML Object that queries the website and retrieves HTML as text
With CreateObject("MSXML2.XMLHttp")
    .Open "GET", sUrl, False
    .send
    sContent = .responseText
End With

With CreateObject("VBScript.RegExp")
    .Global = True
    .MultiLine = True
    .IgnoreCase = False
    .Pattern = "<span class=""avgRate"">(.*?)</span>"

    Set intMatches = .Execute(sContent)

    If intMatches.Count <> 0 Then
        With intMatches
            For mtchCnt = 0 To .Count - 1
                For subMtchCnt = 0 To .Item(subMtchCnt).SubMatches.Count - 1
                    GetRateYear = .Item(mtchCnt).SubMatches(0)
                    Cells(RowNum, ColNum).Value = GetRateYear
                    Cells(RowNum, 1).Value = sYear
                    Cells(RowNum, 2).Value = sFromCrcy
                    RowNum = RowNum + 1
                Next
            Next
        End With
    End If
  End With
  End Function

GetSingleMonth Function:

 Private Function GetSingleMonth(ByVal sFromCrcy As String, ByVal sToCrcy As String, ByVal sYear As String, ByVal RowNumB As Long, ByVal ColNumB As Long)

'This function sends a XML HTTP request, as is much more faster than waiting for browser to DoEvents
'Usage -> Goes to X-rates website and retrieves the code from conversion

Dim sUrl As String
Dim sContent As String
Dim intMatches As Variant
Dim mtchCnt2 As Long
Dim subMtchCnt2 As Long

sUrl = "http://www.x-rates.com/average/?from=" & sFromCrcy & "&to=" & sToCrcy & "&amount=1&year=" & sYear

'XML Object that queries the website and retrieves HTML as text
With CreateObject("MSXML2.XMLHttp")
    .Open "GET", sUrl, False
    .send
    sContent = .responseText
End With

With CreateObject("VBScript.RegExp")
    .Global = True
    .MultiLine = True
    .IgnoreCase = False
    .Pattern = "<span class=""avgMonth"">(.*?)</span>"

    Set intMatches = .Execute(sContent)

    If intMatches.Count <> 0 Then
        With intMatches
            For mtchCnt2 = 0 To .Count - 1
                GetSingleMonth = .Item(mtchCnt2).SubMatches(0)
                Cells(RowNumB, ColNumB).Value = GetSingleMonth
                RowNumB = RowNumB + 1
            Next
        End With
    End If
  End With
  End Function

Styling functions:

Private Sub FormatResultSheet()

'We will center the cells to give a better readability of results and format as text to keep all zeros . Ex: 1.000000
Dim TargetRange As Range
Set TargetRange = ResultSheet.Range("A:F")
TargetRange.HorizontalAlignment = xlCenter
TargetRange.NumberFormat = "@"

End Sub

 Private Sub AddHeader()

'Header cells exist to represent what values are extracted in what columns and are "styled" to stand out for better readability
With ResultSheet
    .Range("A1", "F1").Style = "Input"
    .Range("A1", "F1").Font.Bold = True
    .Cells(1, 1).Value = "Year"
    .Cells(1, 2).Value = "OffSetCurr"
    .Cells(1, 3).Value = "Month"
    .Cells(1, 4).Value = "toEuro"
    .Cells(1, 5).Value = "toDollars"
    .Cells(1, 6).Value = "toPounds"
End With
End Sub

Answer 1

Using Functions

Functions should be used when something is returned and subs should be used when something happens. Since nothing is being returned to the procedure via the Functions they should be Subs, which can still take arguments:

Private Sub GetRateYear(ByVal sFromCrcy As String, ByVal sToCrcy As String, ByVal sYear As String, ByVal RowNum As Long, ByVal ColNum As Long)

If it was instead Private Function GetRateYear(...) you should need to give it a type:

Private Function GetRateYear GetRateYear(ByVal sFromCrcy As String, ByVal sToCrcy As String, ByVal sYear As String, ByVal RowNum As Long, ByVal ColNum As Long) as String

---

For Each String?

Does this work for you -

Dim SCrcy As String
For Each SCrcy In Array("EUR", "USD", "GBP")

It shouldn't let you use a String in a For Each loop. It would be better with a Long

Dim i As Long
For i = 1 to 3
    Array(i)

---

Calling procedures

Still, no need to Call

Call GetSingleMonth("ARS", SCrcy, Period, RowNumB, ColNumB)
Call FormatResultSheet
Call AddHeader

They should work without the call.

---

Using Constants

You use this twice

sUrl = "http://www.x-rates.com/average/?from=" ....

Might as well just make that a Global constant:

Public Const baseURL As String = "http://www.x-rates.com/average/?from="
sUrl = baseURL & sFromCrcy & "&to=" & sToCrcy & "&amount=1&year=" & sYear

That would be declared at the module scope and can be used in any procedures in the module. The same could be said for the usage of "AUD"

---

For without Next

    For i = 1 To 9

I think you missed the Next for this before the error handler - it won't compile without that.

---

Efficiency With Arrays

With resultsheet
    .Range("A1", "F1").Style = "Input"
    .Range("A1", "F1").Font.Bold = True
    .Cells(1, 1).Value = "Year"
    .Cells(1, 2).Value = "OffSetCurr"
    .Cells(1, 3).Value = "Month"
    .Cells(1, 4).Value = "toEuro"
    .Cells(1, 5).Value = "toDollars"
    .Cells(1, 6).Value = "toPounds"
End With

This can be more efficient using an array:

Dim arr(1 To 6) As String
arr(1) = "Year"
arr(2) = "OffSetCurr"
arr(3) = "Month"
arr(4) = "toEuro"
arr(5) = "toDollars"
arr(6) = "toPounds"

resultsheet.Range("A1:F1") = arr()

---

Variables

Variable names - give your variables meaningful names. Characters are free! Also standard VBA naming conventions have camelCase for local variables and PascalCase for other variables and names.

Dim RowNum As Long - rowNumber
Dim ColNum As Long - columnNumber
Dim RowNumB As Long - nextRow
Dim ColNumB As Long - nextColumn
Dim i As Long
Dim Period As String - period
Dim SCrcy As Variant - sourceCurrency?
Dim MsgErr As String - errorMessage

---

Inputbox Arguments

I thought this was cute

Period = Application.InputBox("What's the year you want to collect back data?", "Period", , , , , 2)

You don't need to give it the null arguments:

period = Application.Inputbox("What's the year you want to collect back data?","Period",HelpContextID:=2)

Though, I think you were aiming at Type:=. And if you're going to start being explicit, just make the whole thing explicit:

period = Application.Inputbox(Prompt:="What's the year you want to collect back data?", Title:="Period", Type:=2)

---

Checking User Input

I am not sure what's happening here

If Len(Period) <> 4 Then
    GoTo ErrHandler
    Exit Sub
End If

GoTo ErrHandler will skip the Exit Sub. But, err.Number will = 0 so the ErrHandler won't do its thing. If you don't want to tell the user what they did wrong you can just

If Len(period) <> 4 then Exit Sub

Otherwise, I'd let them know

If Len(period) <> 4 then
   msgbox "Please use 4 digits. Exiting procedure"
   Exit Sub
End if

Or, give them another chance.

period = GetPeriod
If IsEmpty(period) then Exit Sub

with a function:

Private Function GetPeriod() As Long
    Dim period As Long
    Dim cancel As String
GetInput:
    period = Application.InputBox(Prompt:="What's the year you want to collect back data?", Title:="Period", Type:=2)

    If Len(period) <> 4 Then
        MsgBox "Please use four digits"
        cancel = MsgBox("Would you like to cancel", vbYesNo)
        If cancel = vbYes Then Exit Function
        GoTo GetInput
    End If
    GetPeriod = period
End Function

You could just leave it as it is and assign a custom Err.Number for the handler, but I don't have an example of that.