Getting data from a website

[Bricklin]

I'm trying to adapt some code that I found that allows me to access a website and update some base interest rate information into my workbook. It works, but has some issues. Can someone take a look at it and offer some suggestions?

I want the macro to run when I open the workbook and update the rates. It doesn't need to access the website after that. I just want to update it each time the workbook is opened. The data link works fine, but I'm having problems with importing the data to a sheet that is hidden (sheet is name "Magic" and most of the sheet is protected). I have unprotected the range where the data is imported, but I'm getting error messages when I open the workbook that says " The cell or chart that you are trying to change is protected and therefore read-only. To modify a protected cell or chart, firt remove protection using the Unprotect Sheet command (review tab, Changes,group). You may be prompted for a password."

I'd like to keep the sheet hidden and protected if possible. Is there a way to modify my code below to turn the protection off - allow the update- and then turn it back on?

My macro is below.

Sub Import_H15_Rates()
'
' Import_H15 Macro
'

'
    Application.ScreenUpdating = False
    Sheets("Magic").Visible = True
    Sheets("Magic").Select
    ActiveSheet.Unprotect
    Range("M100").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.federalreserve.gov/releases/h15/update/default.htm", _
        Destination:=Range("$M$100"))
        .Name = "default_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = True
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Range("M100").Select
    ActiveSheet.Protect
    Sheets("Magic").Visible = False
    Sheets("Input").Select
    Range("F12:K12").Select
End Sub

 

[Deepak]

for the protecting issue!

do like as ...

sheet.unprotect
...your code...
sheet.protect

 

[Khalid NGO]

Hi @Bricklin

This seems like a follow up question to the thread you've already posted:
http://chandoo.org/forum/threads/macro-to-check-for-internet-connection.26571/

 

[Bricklin]

Still a bug...

If I open the workbook and call the following macro I get the error messages as described above. If I run the macro after the sheet is already open it works perfectly. How do I run this when opening the sheet to avoid the error messages?

Sub Import_H15_Rates()
'
' Import_H15 Macro
'

'
    Application.ScreenUpdating = False
    Sheets("Magic").Visible = True
    Sheets("Magic").Select
    ActiveSheet.Unprotect
    Range("M100").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.federalreserve.gov/releases/h15/update/default.htm", _
        Destination:=Range("$M$100"))
        .Name = "default_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = False
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
 
    Range("$AK$5").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.bankrate.com/rates/interest-rates/libor.aspx", Destination:= _
        Range("$AK$5"))
        .Name = "libor"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = False
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

    ActiveSheet.Protect
    Sheets("Magic").Visible = False
    Sheets("Input").Select
    Range("F12:K12").Select
End Sub

This is the workbook open macro that calls for the "update H15 sub at startup

Private Sub Workbook_Open()
    Dim warning As Date
    Dim exdate As Date
    Dim rates As Date
    Dim xdate As Date
    warning = "12/01/2015"
    exdate = "01/31/2016"
    xdate = Worksheets("Tables").Range("D1")

        If Date > warning Then
            MsgBox ("This version of the Quote Tool will be expire soon. To remove this message, please contact me for an updated version.")
            MsgBox ("You have " & exdate - Date & " Days left")
        End If
        If Date > exdate Then
            MsgBox ("WARNING!  This version of the Quote Tool has expired. Please contact me for an updated version.")
            ActiveWorkbook.Close
        End If
     
           
        If Month(Date) = Month(xdate) And (Day(Date) - Day(xdate)) <= 1 Then
            MsgBox "Interest rate tables are up to date."
        Else
            MsgBox "Interest rate tables were last updated on " & Worksheets("Tables").Range("D1") & ".  They will be automatically updated"
            Call Import_H15_Rates
        End If
       
End Sub

Additionally, in a perfect world, I would like the message boxes to automatically close after 10 seconds.

As usual, your help is greatly appreciated.


Mod edit: Plz tag the codes.