In an effort to automatically provide a variety of currency rates for a user-specified time period, I've been working on a table. I've been attempting to modify the VBA code to incorporate several currency conversions since I came across this article, which I thought to be quite helpful. But I can't seem to figure out how to do this and I keep getting the following error:
Error 1004: Microsoft Office Excel can convert only one column at a time. The range can be many rows tall but no more than one column wide. Try again by selecting cells in one column only.
Could you please have a look at my code below and help me resolve the error so that I can obtain multiple currency conversions? Many thanks in advance.
Sub GetData()
Dim DataSheet As Worksheet
Dim endDate As String
Dim startDate As String
Dim str As String
Dim LastRow As Integer
Sheets("GBP").Cells.Clear
Set DataSheet = ActiveSheet
startDate = DataSheet.Range("startDate").Value
endDate = DataSheet.Range("endDate").Value
' GBP/EUR
str = "http://www.oanda.com/currency/historical-rates/download?quote_currency=" _
& "GBP" _
& "&end_date=" _
& Year(endDate) & "-" & Month(endDate) & "-" & Day(endDate) _
& "&start_date=" _
& Year(startDate) & "-" & Month(startDate) & "-" & Day(startDate) _
& "&period=daily&display=absolute&rate=0&data_range=c&price=bid&view=table&base_currency_0=" _
& "EUR" _
& "&base_currency_1=&base_currency_2=&base_currency_3=&base_currency_4=&download=csv"
With Sheets("GBP").QueryTables.Add(Connection:="URL;" & str, Destination:=Sheets("GBP").Range("A1"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
Sheets("GBP").Range("A5").CurrentRegion.TextToColumns Destination:=Sheets("GBP").Range("A5"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, other:=True, OtherChar:=",", FieldInfo:=Array(1, 2)
Sheets("GBP").Columns("A:B").ColumnWidth = 12
Sheets("GBP").Range("A1:B2").Clear
LastRow = Sheets("GBP").UsedRange.Row - 6 + Sheets("GBP").UsedRange.Rows.Count
Sheets("GBP").Range("A" & LastRow + 2 & ":B" & LastRow + 5).Clear
' GBP/USD
str = "http://www.oanda.com/currency/historical-rates/download?quote_currency=" _
& "GBP" _
& "&end_date=" _
& Year(endDate) & "-" & Month(endDate) & "-" & Day(endDate) _
& "&start_date=" _
& Year(startDate) & "-" & Month(startDate) & "-" & Day(startDate) _
& "&period=daily&display=absolute&rate=0&data_range=c&price=bid&view=table&base_currency_0=" _
& "USD" _
& "&base_currency_1=&base_currency_2=&base_currency_3=&base_currency_4=&download=csv"
With Sheets("GBP").QueryTables.Add(Connection:="URL;" & str, Destination:=Sheets("GBP").Range("C1"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
Sheets("GBP").Range("C5").CurrentRegion.TextToColumns Destination:=Sheets("GBP").Range("C5"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, other:=True, OtherChar:=",", FieldInfo:=Array(1, 2)
Sheets("GBP").Columns("C:D").ColumnWidth = 12
Sheets("GBP").Range("C1:D2").Clear
LastRow = Sheets("GBP").UsedRange.Row - 6 + Sheets("GBP").UsedRange.Rows.Count
Sheets("GBP").Range("C" & LastRow + 2 & ":D" & LastRow + 5).Clear
End Sub
The error occurs at the following line:
Sheets("GBP").Range("C5").CurrentRegion.TextToColumns Destination:=Sheets("GBP").Range("C5"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, other:=True, OtherChar:=",", FieldInfo:=Array(1, 2)