Excel Data Refresh

K

klatlap

Well-known Member
Joined
Sep 1, 2004
Messages
607
Office Version
  1. 2013
Platform
  1. Windows
Hi,

I have an issue, i use excel mostly for importing data but lately i notice that after i have imported the data and all macros have stopped every few minutes excel will lock up and looks like it is refreshing, also when i go to close and save the workbook it takes 2 minutes or more to close, it may be an issue with my pc but i thought i would check here first, here are the macros i am running.

Code: 
Public Function ExecuteWebRequest(url As String) As String
    Dim oXHTTP As Object
    Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
    oXHTTP.Open "GET", url, False
    oXHTTP.send
    ExecuteWebRequest = oXHTTP.responseText
    Set oXHTTP = Nothing
End Function

Code: 
Public Function outputtext(text As String)
Dim MyFile As String, fnum As String
        MyFile = ThisWorkbook.Path & "\temp.txt"
        fnum = FreeFile()
        Open MyFile For Output As fnum
        Print #fnum, text
        Close #fnum
End Function

Code: 
Function GetAddress(HyperlinkCell As Range)
    GetAddress = Replace _
    (HyperlinkCell.Hyperlinks(1).Address, "mailto:", "")
End Function

Code: 
Sub clear()
Sheets("Selections").Select
Range("A5:I20000").Select
Selection.ClearContents
Range("G2").Value = 0
End Sub

Code: 
Sub Start()
Application.ScreenUpdating = False
If Sheets("Selections").Range("G2").Value <> 0 And Sheets("Selections").Range("G2").Value = Sheets("Selections").Range("G3").Value Then End
Sheets("Selections").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 1).Value _
= Sheets("Selections").Range("D3").Value
Sheets("Meetings").Select
Range("A1:P500").Select
Selection.ClearContents
Meetings
End Sub

Code: 
Sub Meetings()
Dim objWeb As QueryTable
        Set objWeb = ActiveSheet.QueryTables.Add(Connection:="URL;https://tatts.com/racing/" _
        & Format(Sheets("Selections").Range("D3").Value, "DD/MM/YYYY") & "/RaceDay", _
        Destination:=Range("$A$1"))
  With objWeb
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingAll
        .WebTables = "2"
        .SaveData = True
        .Refresh BackgroundQuery:=False
    End With
    Sheets("Selections").Select
    Range("H1:H2").Select
    Selection.ClearContents
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "=Meetings!R[-1]C[27]"
    Application.ScreenUpdating = True
    newvenue
    End Sub

Code: 
Sub newvenue()
Sheets("Selections").Range("B2").Value = 1
Range("A2").Select
Set s = ActiveCell
Set h1 = Range("H1")
Set h2 = Range("H2")
h1.Formula = s.Formula
h1.Copy h2
s.Formula = h2.Formula
  If Sheets("Selections").Range("A2").Value = "" Then
  newvenue
  End If
  If Sheets("Selections").Range("A2").Value = "END" Then
  Sheets("Selections").Range("G2").Value = Sheets("Selections").Range("G2").Value + 1
  Start
  End If
  Import
End Sub

Code: 
Sub Import()
Application.ScreenUpdating = False
Sheets("Selections").Select
If Range("B2").Value = Range("G1").Value + 1 Then
GoTo Clr
Else
If Range("B2").Value < 1 Then
GoTo xit
Else
End If
Sheets("Race").Select
    Sheets("Race").Cells.Select
    Selection.ClearContents
formhtml = ExecuteWebRequest(ThisWorkbook.Sheets("Meetings").Range("V1").Value)
    outputtext (formhtml)
    Set temp_qt = ThisWorkbook.Sheets("Race").QueryTables.Add(Connection:= _
            "URL;" & ThisWorkbook.Path & "\temp.txt" _
            , Destination:=ThisWorkbook.Sheets("Race").Range("$A$1"))
    With temp_qt
        .RefreshStyle = xlOverwriteCells
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "13,17"
        .SaveData = True
        .Refresh BackgroundQuery:=False
        End With
If Sheets("Race").Range("C1").Value = "" Then
Sheets("Race").Cells.Select
    Selection.ClearContents
    formhtml = ExecuteWebRequest(ThisWorkbook.Sheets("Meetings").Range("V1").Value)
    outputtext (formhtml)
    Set temp_qt = ThisWorkbook.Sheets("Race").QueryTables.Add(Connection:= _
            "URL;" & ThisWorkbook.Path & "\temp.txt" _
            , Destination:=ThisWorkbook.Sheets("Race").Range("$A$1"))
    With temp_qt
        .RefreshStyle = xlOverwriteCells
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "11,12"
        .SaveData = True
        .Refresh BackgroundQuery:=False
        End With
        End If
formhtml = ExecuteWebRequest(ThisWorkbook.Sheets("Meetings").Range("V1").Value)
    outputtext (formhtml)
    Set temp_qt = ThisWorkbook.Sheets("Race").QueryTables.Add(Connection:= _
            "URL;" & ThisWorkbook.Path & "\temp.txt" _
            , Destination:=ThisWorkbook.Sheets("Race").Range("$A$40"))
    With temp_qt
        .RefreshStyle = xlOverwriteCells
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "4"
        .SaveData = True
        .Refresh BackgroundQuery:=False
        End With
 ActiveSheet.QueryTables.Item(1).Delete
    Set temp_qt = Nothing
    Kill ThisWorkbook.Path & "\temp.txt"
    If ThisWorkbook.Connections.Count > 0 Then ThisWorkbook.Connections.Item(ThisWorkbook.Connections.Count).Delete
End If
   Sheets("Meetings").Select
Range("V2").Select
Selection.ClearContents
   Sheets("Data").Select
If Range("C1") = "" Then
GoTo xit
Else
Sheets("Selections").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 7).Value = Sheets("Data").Range("A1:G1").Value
End If
xit:
   Sheets("Selections").Select
   Application.ScreenUpdating = True
   Range("B2").Value = Range("B2").Value + 1
Import
Clr:    For i = 1 To ActiveWorkbook.Connections.Count
If ActiveWorkbook.Connections.Count = 0 Then Exit Sub
ActiveWorkbook.Connections.Item(i).Delete
i = i - 1
Next i
Sheets("Selections").Select
Range("A2").Select
newvenue
End Sub

Code: 
Sub Import2()
ActiveCell.Select
    Selection.Copy
    Range("V2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.ScreenUpdating = False
Sheets("Race").Select
    Sheets("Race").Cells.Select
    Selection.ClearContents
formhtml = ExecuteWebRequest(ThisWorkbook.Sheets("Meetings").Range("V1").Value)
    outputtext (formhtml)
    Set temp_qt = ThisWorkbook.Sheets("Race").QueryTables.Add(Connection:= _
            "URL;" & ThisWorkbook.Path & "\temp.txt" _
            , Destination:=ThisWorkbook.Sheets("Race").Range("$A$1"))
    With temp_qt
        .RefreshStyle = xlOverwriteCells
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "13,17"
        .SaveData = True
        .Refresh BackgroundQuery:=False
        End With
If Sheets("Race").Range("C1").Value = "" Then
Sheets("Race").Cells.Select
    Selection.ClearContents
    formhtml = ExecuteWebRequest(ThisWorkbook.Sheets("Meetings").Range("V1").Value)
    outputtext (formhtml)
    Set temp_qt = ThisWorkbook.Sheets("Race").QueryTables.Add(Connection:= _
            "URL;" & ThisWorkbook.Path & "\temp.txt" _
            , Destination:=ThisWorkbook.Sheets("Race").Range("$A$1"))
    With temp_qt
        .RefreshStyle = xlOverwriteCells
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "11,12"
        .SaveData = True
        .Refresh BackgroundQuery:=False
        End With
        End If
formhtml = ExecuteWebRequest(ThisWorkbook.Sheets("Meetings").Range("V1").Value)
    outputtext (formhtml)
    Set temp_qt = ThisWorkbook.Sheets("Race").QueryTables.Add(Connection:= _
            "URL;" & ThisWorkbook.Path & "\temp.txt" _
            , Destination:=ThisWorkbook.Sheets("Race").Range("$A$40"))
    With temp_qt
        .RefreshStyle = xlOverwriteCells
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "4"
        .SaveData = True
        .Refresh BackgroundQuery:=False
        End With
 ActiveSheet.QueryTables.Item(1).Delete
    Set temp_qt = Nothing
    Kill ThisWorkbook.Path & "\temp.txt"
    If ThisWorkbook.Connections.Count > 0 Then ThisWorkbook.Connections.Item(ThisWorkbook.Connections.Count).Delete
    Sheets("Data").Select
End Sub
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
Sort by date Sort by votes
is your autosave set at 2 minutes

close should generate a save

your clear sub could be written like
Code: 
Sub clear()
Sheets("Selections").Range("A5:I20000").ClearContents
Range("G2").Value = 0
End Sub

do you have a lot of cf or volatile formulas

are your sheet ends where you expect them (CTRL + END)
 
Upvote 0
Auto save is set to 10 minutes.

The clear macro is a manual one and isn't used often

Honestly very little formulas, i did try the CTRL+End and on one page it went to 30,000 where i am using a sum formula that counts to 10,000, could that be the issues, as i record data it adds a row of numbers that need to be calculated, as i never know how many rows to sum i just have it sum from 5 to 10,000 even if there is only a couple hundred lines used at that time.
 
Upvote 0
You must log in or register to reply here.

Similar threads

V
  • Question Question
Excel VBA - How to modify my code to include a command that prints data to PDF
Replies
1
Views
505
VanGirl
V
K
  • Question Question
Scraping a table from a website, VBA code needs to be updated, running into issues
Replies
1
Views
546
Dan_W
D
T
  • Question Question
web scraping on office 2021
Replies
4
Views
393
Tonmoymridha
T
L
  • Question Question
VBA to export recurring meeting data
Replies
1
Views
1K
John_w
J
A
  • Question Question
Getting table from a link from a cell value
Replies
0
Views
533
adipat
A

Forum statistics

Threads
1,223,248
Messages
6,171,011
Members
452,374
Latest member
keccles

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top