datkewlguy
09-28-2012, 09:46 AM
Hi guys - I'm new to VBA and the forum, so please forgive my naïveté.
I have a macro that I found online to retrieve exchange rates from the internet. I commented out part of it, as I didn't need it to create charts, and while the code works fine, I'm getting some unreadable content errors when I restart the workbook:
"Excel found unreadable content in 'filename.xlsm'. Do you want to recover the contents of this workbook? If you trust the source of this workbook, click Yes."
Followed by:
"Removed Records: Object from /xl/printerSettings/printerSettings1.bin part (Print options)"
The code that's causing this is somewhere in here:
Option Explicit
Sub GetData()
Dim DataSheet As Worksheet
Dim endDate As String
Dim startDate As String
Dim fromCurr As String
Dim toCurr As String
Dim str As String
Dim LastRow As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Data").Cells.Clear
Set DataSheet = ActiveWorkbook.Sheets("Exchange Rate")
startDate = DataSheet.Range("thirtydaysago").Value
endDate = DataSheet.Range("today").Value
fromCurr = DataSheet.Range("domesticCurrency").Value
toCurr = DataSheet.Range("foreignCurrency").Value
str = "[website removed]" _
& fromCurr _
& "&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=" _
& toCurr _
& "&base_currency_1=&base_currency_2=&base_currency_3=&base_currency_4=&download=csv"
QueryQuote:
With Sheets("Data").QueryTables.Add(Connection:="URL;" & str, Destination:=Sheets("Data").Range("a1"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
Sheets("Data").Range("a5").CurrentRegion.TextToColumns Destination:=Sheets("Data").Range("a5"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, other:=True, OtherChar:=",", FieldInfo:=Array(1, 2)
Sheets("Data").Columns("A:B").ColumnWidth = 12
Sheets("Data").Range("A1:b2").Clear
LastRow = Sheets("Data").UsedRange.Row - 6 + Sheets("Data").UsedRange.Rows.Count
Sheets("Data").Range("A" & LastRow + 2 & ":b" & LastRow + 5).Clear
Sheets("Data").Sort.SortFields.Add Key:=Range("A5:A" & LastRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Sheets("Data").Sort
.SetRange Range("A5:b" & LastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
.SortFields.Clear
End With
'DeleteCharts
Application.DisplayAlerts = True
' With ActiveSheet.ChartObjects.Add _
' (Left:=Range("F16").Left, Width:=490, Top:=Range("F16").Top, Height:=225)
' .Chart.SetSourceData Source:=Sheets("Data").Range("A5:b" & LastRow)
' .Chart.ChartType = xlLine
' End With
'Dim ch As ChartObject
'For Each ch In ActiveSheet.ChartObjects
'ch.Select
'ActiveChart.Axes(xlValue).MinimumScale = WorksheetFunction.Min(Sheets("Data").Range("b5:b" & LastRow))
'ActiveChart.Axes(xlValue).MaximumScale = WorksheetFunction.Max(Sheets("Data").Range("b5:b" & LastRow))
'ActiveChart.Legend.Select
'Selection.Delete
'Next ch
End Sub
'Sub DeleteCharts()
'On Error GoTo ExitChart
'Dim ws As Worksheet
'Dim chObj As ChartObject
'Application.DisplayAlerts = False
'
'For Each ws In ActiveWorkbook.Worksheets
'For Each chObj In ws.ChartObjects
'chObj.Delete
'Next chObj
'Next ws
'
'ActiveWorkbook.Charts.Delete
'
'ExitChart:
'Application.DisplayAlerts = True
'Exit Sub
'End Sub
I've been searching for hours and haven't been able to find a solution. I'm sure there are issues with this code, so if anyone has any insight, it'd be greatly appreciated!
Edit: Looks like I had to remove the URL in the VBA due to my post count. Hopefully you can still make sense of it.
I have a macro that I found online to retrieve exchange rates from the internet. I commented out part of it, as I didn't need it to create charts, and while the code works fine, I'm getting some unreadable content errors when I restart the workbook:
"Excel found unreadable content in 'filename.xlsm'. Do you want to recover the contents of this workbook? If you trust the source of this workbook, click Yes."
Followed by:
"Removed Records: Object from /xl/printerSettings/printerSettings1.bin part (Print options)"
The code that's causing this is somewhere in here:
Option Explicit
Sub GetData()
Dim DataSheet As Worksheet
Dim endDate As String
Dim startDate As String
Dim fromCurr As String
Dim toCurr As String
Dim str As String
Dim LastRow As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Data").Cells.Clear
Set DataSheet = ActiveWorkbook.Sheets("Exchange Rate")
startDate = DataSheet.Range("thirtydaysago").Value
endDate = DataSheet.Range("today").Value
fromCurr = DataSheet.Range("domesticCurrency").Value
toCurr = DataSheet.Range("foreignCurrency").Value
str = "[website removed]" _
& fromCurr _
& "&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=" _
& toCurr _
& "&base_currency_1=&base_currency_2=&base_currency_3=&base_currency_4=&download=csv"
QueryQuote:
With Sheets("Data").QueryTables.Add(Connection:="URL;" & str, Destination:=Sheets("Data").Range("a1"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
Sheets("Data").Range("a5").CurrentRegion.TextToColumns Destination:=Sheets("Data").Range("a5"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, other:=True, OtherChar:=",", FieldInfo:=Array(1, 2)
Sheets("Data").Columns("A:B").ColumnWidth = 12
Sheets("Data").Range("A1:b2").Clear
LastRow = Sheets("Data").UsedRange.Row - 6 + Sheets("Data").UsedRange.Rows.Count
Sheets("Data").Range("A" & LastRow + 2 & ":b" & LastRow + 5).Clear
Sheets("Data").Sort.SortFields.Add Key:=Range("A5:A" & LastRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Sheets("Data").Sort
.SetRange Range("A5:b" & LastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
.SortFields.Clear
End With
'DeleteCharts
Application.DisplayAlerts = True
' With ActiveSheet.ChartObjects.Add _
' (Left:=Range("F16").Left, Width:=490, Top:=Range("F16").Top, Height:=225)
' .Chart.SetSourceData Source:=Sheets("Data").Range("A5:b" & LastRow)
' .Chart.ChartType = xlLine
' End With
'Dim ch As ChartObject
'For Each ch In ActiveSheet.ChartObjects
'ch.Select
'ActiveChart.Axes(xlValue).MinimumScale = WorksheetFunction.Min(Sheets("Data").Range("b5:b" & LastRow))
'ActiveChart.Axes(xlValue).MaximumScale = WorksheetFunction.Max(Sheets("Data").Range("b5:b" & LastRow))
'ActiveChart.Legend.Select
'Selection.Delete
'Next ch
End Sub
'Sub DeleteCharts()
'On Error GoTo ExitChart
'Dim ws As Worksheet
'Dim chObj As ChartObject
'Application.DisplayAlerts = False
'
'For Each ws In ActiveWorkbook.Worksheets
'For Each chObj In ws.ChartObjects
'chObj.Delete
'Next chObj
'Next ws
'
'ActiveWorkbook.Charts.Delete
'
'ExitChart:
'Application.DisplayAlerts = True
'Exit Sub
'End Sub
I've been searching for hours and haven't been able to find a solution. I'm sure there are issues with this code, so if anyone has any insight, it'd be greatly appreciated!
Edit: Looks like I had to remove the URL in the VBA due to my post count. Hopefully you can still make sense of it.