[RESOLVED] Procedure Stops Unexpectedly
I am using VBA in Excel 2007.
I tried runningthrough the code step-by-step and once you try to step past the "Selection.Clear" statement the program ends as if someone clicked on the Stop/Reset Button. I have no clue as to why this is happening. I don't even receive an error so I can no clue as to where I should start looking for the problem.
Code:
Sub Import_Data(strDate As Date)
'This procedure imports the data for the month requested in the variable strDate.
Sheets("RawData").Select
Range("A2:AK50").Select
Selection.Clear
'The error handler informs the user with the developer's name should there be a problem
'importing the data.
On Error GoTo ErrorHandler
Sheets("RawData").Activate
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://etc/etc/Test_1_" & Format(strDate, "mmyy") & ".txt", _
Destination:=Range("$C$1"))
.Name = "Test_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = False
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://etc/etc/Test_2_" & Format(strDate, "mmyy") & ".txt", _
Destination:=Range("$F$1"))
.Name = "Test_2"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = False
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://etc/etc/Test_3_" & Format(strDate, "mmyy") & ".txt", _
Destination:=Range("$I$1"))
.Name = "Test_3"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = False
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://etc/etc/Test_4_" & Format(strDate, "mmyy") & ".txt", _
Destination:=Range("$V$1"))
.Name = "Test_4"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = False
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://etc/etc/Test_5_" & Format(strDate, "mmyy") & ".txt", _
Destination:=Range("$Z$1"))
.Name = "Test_5"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = False
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Range("AK2").Value = DateAdd("m", -1, strDate)
'Calls the procedure containing the date the data was last updated
Call Last_Updated
Call Report1
Call Report2
Call Report3
Call Report4
Call Report5
Exit Sub
ErrorHandler:
Call MsgBox(Format(DateAdd("m", -1, strDate), "mmmm") & "'s data is not available at this time. Please try again after you receive the email that the data has been updated. If you received this message after receiving an email that the data has already been updated for " & Format(DateAdd("m", -1, strDate), "mmmm") & ", please contact Developer Name (ID123).", vbOKOnly, "Data Not Found")
End Sub
Re: Procedure Stops Unexpectedly
Quote:
Call Last_Updated
Call Report1
Call Report2
Call Report3
Call Report4
Call Report5
If I remove this from your code and run it then I see the message box so definitely the error lies somewhere in the above subs...
Can I see that as well?
BTW, this is what I tried...
Code:
Sub sample()
Import_Data #12/12/2009#
End Sub
Sub Import_Data(strDate As Date)
Dim ws As Worksheet
Set ws = Sheets("RawData")
ws.Range("A2:AK50").Clear
On Error GoTo ErrorHandler
With ws.QueryTables.Add(Connection:="URL;http://etc/etc/Test_1_" & _
Format(strDate, "mmyy") & ".txt", Destination:=Range("$C$1"))
.Name = "Test_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = False
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
With ws.QueryTables.Add(Connection:= _
"URL;http://etc/etc/Test_2_" & Format(strDate, "mmyy") & ".txt", _
Destination:=Range("$F$1"))
.Name = "Test_2"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = False
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
With ws.QueryTables.Add(Connection:= _
"URL;http://etc/etc/Test_3_" & Format(strDate, "mmyy") & ".txt", _
Destination:=Range("$I$1"))
.Name = "Test_3"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = False
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
With ws.QueryTables.Add(Connection:= _
"URL;http://etc/etc/Test_4_" & Format(strDate, "mmyy") & ".txt", _
Destination:=Range("$V$1"))
.Name = "Test_4"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = False
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
With ws.QueryTables.Add(Connection:= _
"URL;http://etc/etc/Test_5_" & Format(strDate, "mmyy") & ".txt", _
Destination:=Range("$Z$1"))
.Name = "Test_5"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = False
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Range("AK2").Value = DateAdd("m", -1, strDate)
Exit Sub
ErrorHandler:
Call MsgBox(Format(DateAdd("m", -1, strDate), "mmmm") & _
"'s data is not available at this time. " & _
"Please try again after you receive the email that the data has been updated. " & _
"If you received this message after receiving an email that the data has already" & _
"been updated for " & Format(DateAdd("m", -1, strDate), "mmmm") & _
", please contact Developer Name (ID123).", vbOKOnly, "Data Not Found")
End Sub
Re: Procedure Stops Unexpectedly
Thanks for the help Kool. I tried removing those Call's, but I still had the same issue. However, I did rewrite the top part as you did "Dim ws as Worksheet...etc...etc" and it runs just fine now.
I've always written it the way I had it previously and I've never had a problem. I don't know why it's being so anal now. Though, it probably is better practice to declare it as you did.
Thanks again.
Re: [RESOLVED] Procedure Stops Unexpectedly
