I've been using this code for about three weeks now without this error coming up. Something just changed this morning but I'm not sure what?
Code:
Option Explicit
Sub GET_XYZ(Day_Count As Long)
'Arrays
Dim XYZ_Data As Variant
Dim List_Array As Variant
Dim Sheet_ARG As Variant
'Dates and Times
Dim Date_String As String
Dim Day_x As Long
Dim Month_x As Long
Dim Year_x As Long
Dim Hour_x As Long
'Timer Tracking
Dim StartTime As Double
'Web Address
Dim Wait_Time As Long
Dim theURL As String
Dim ie As Object
Dim WS As Worksheet
Application.ScreenUpdating = False
'Timer is used to monitor speed/bugginess of the script
StartTime = Timer
'Get Array of Dates and Data
List_Array = Sheets("List").Range("A1:E2000").Value
XYZ_Data = Sheets("XYZ Data").Range("A1:Z100000")
'Determine what Date to start on
Date_String = List_Array(Day_Count, 1)
Year_x = Left(Date_String, 4)
Month_x = Right(Left(Date_String, 7), 2)
Day_x = Right(Date_String, 2)
Wait_Time = 0
[B][U]Set ie = CreateObject("internetexplorer.application")[/U][/B]
theURL = www.xyz.com
ie.Navigate theURL
ie.Visible = False
While ie.Busy
DoEvents
Wend
'Application.Wait DateAdd("s", Wait_Time, Now)
ie.ExecWB 17, 0 '// SelectAll
ie.ExecWB 12, 2 '// Copy selection
If Wait_Time = 0 Then
'If the Target Worksheet alread exists delete it
For Each WS In Worksheets
If WS.Name = Date_String Then
Application.DisplayAlerts = False
Sheets(Date_String).Delete
Application.DisplayAlerts = True
'End
End If
Next
Worksheets.Add().Name = Date_String
End If
ActiveSheet.PasteSpecial Format:="Text", link:=False, DisplayAsIcon:=False
If Left(ActiveSheet.Range("A" & 1), 2) <> Day_x Then
'If Dates don't match the code runs again with a longer wait time
Wait_Time = Wait_Time + 5
Else
Sheet_ARG = Sheets(Date_String).Range("A1:Z100")
'Move Data
Hour_x = 1
Do While Hour_x < 25
XYZ_Data(((Day_Count - 1) * 24 + 1 + Hour_x), 1) = Date_String
XYZ_Data(((Day_Count - 1) * 24 + 1 + Hour_x), 2) = Hour_x
XYZ_Data(((Day_Count - 1) * 24 + 1 + Hour_x), 3) = Sheet_ARG(Hour_x + 2, 8)
XYZ_Data(((Day_Count - 1) * 24 + 1 + Hour_x), 4) = Sheet_ARG(Hour_x + 2, 6)
XYZ_Data(((Day_Count - 1) * 24 + 1 + Hour_x), 5) = Sheet_ARG(Hour_x + 2, 16)
XYZ_Data(((Day_Count - 1) * 24 + 1 + Hour_x), 6) = Sheet_ARG(Hour_x + 2, 4)
XYZ_Data(((Day_Count - 1) * 24 + 1 + Hour_x), 7) = Sheet_ARG(Hour_x + 2, 10)
XYZ_Data(((Day_Count - 1) * 24 + 1 + Hour_x), 8) = Sheet_ARG(Hour_x + 2, 14)
XYZ_Data(((Day_Count - 1) * 24 + 1 + Hour_x), 9) = Sheet_ARG(Hour_x + 2, 12)
XYZ_Data(((Day_Count - 1) * 24 + 1 + Hour_x), 10) = Sheet_ARG(Hour_x + 30, 4)
XYZ_Data(((Day_Count - 1) * 24 + 1 + Hour_x), 11) = Sheet_ARG(Hour_x + 30, 12)
XYZ_Data(((Day_Count - 1) * 24 + 1 + Hour_x), 12) = Sheet_ARG(Hour_x + 30, 6)
XYZ_Data(((Day_Count - 1) * 24 + 1 + Hour_x), 13) = Sheet_ARG(Hour_x + 30, 8)
XYZ_Data(((Day_Count - 1) * 24 + 1 + Hour_x), 14) = Sheet_ARG(Hour_x + 30, 10)
Hour_x = Hour_x + 1
Loop
Application.DisplayAlerts = False
Sheets(Date_String).Delete
Application.DisplayAlerts = True
Sheets("XYZ Data").Range("A1:Z100000") = XYZ_Data
Day_Count = Day_Count + 1
Date_String = List_Array(Day_Count, 1)
Year_x = Left(Date_String, 4)
Month_x = Right(Left(Date_String, 7), 2)
Day_x = Right(Date_String, 2)
'Exit Logic
If Sheets("Scratch").Range("A3") = "The webpage cannot be found" Then
MsgBox Timer - StartTime
Exit Sub
End If
'Once the program gets up to the current day it jumps out of the loop
If Year_x = Format(Now(), "yyyy") Then
If Month_x = Format(Now(), "mm") Then
If Day_x = Format(Now(), "dd") Then
Application.ScreenUpdating = True
Sheets("XYZ Data").Range("A1:Z100000") = XYZ_Data
MsgBox Timer - StartTime
Exit Sub
End If
End If
End If
Wait_Time = 0
End If
Loop
