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

• svacx: Also, a big shout out to @Mat'sMug for helping!
• svacx: And to @Raystafarian who helped so much in this quest!
• Kaz: Trust me, this is not long VBA code.
• Raystafarian: I think the code block might have messed up your indentation - take a look at it

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.

• svacx: I can't seem to remove the Call from GetRateYear and GetSingleMonth, since I have made them as sub (as awsomely told me) and it now gives an error, so I've done this: Dim yearRate as String yearRate = GetRateYear(AUD sourceCurrency, period, rowNumber, columnNumber) . Is it ok like this?
• Raystafarian: If you have arguments place them to the right, if that doesn't work, put them in paranthesis