I am not sure why the On Error goto does not handle the following error.
I have a web query set up in cell T10 that I select and change the URL and attempt to pull a table into the sheet.
I do this 20-30 times with different URL's.
Sometimes the data pull takes too long or something else happens that won't allow excel to get the data...
In those cases I want to handle the error and continue.
But I am still getting the runtime error '1004' and debug shows .Refresh BackgroundQuery:=False highlighted.
But shouldn't the On Error grab that and goto line CardDataPullError further down in the sheet?
I can invoke this issue by changing the IP to something other that my target.
On Error GoTo CardDataPullError
NodeIP = "192.168.210.4"
Range("T10").Select
With Selection.QueryTable
.Connection = "URL;http://" & NodeIP & ":21495/" & Card & "/ispCktDBPage"
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "3"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
On Error GoTo 0
'below is another section of code that highlights the cell red
'showing it had a problem pulling the data
GoTo SkipCard ' To skip error handler
CardDataPullError:
X = X
Cells(CardRow, CardCol).Interior.ColorIndex = 3 ' Red
SkipCard:
'other reasons to skip to
You forgot to put resume in the CardDataPullError error handler.
Therefore the error is not handled.
Change the code as follows:
CardDataPullError:
X = X
Cells(CardRow, CardCol).Interior.ColorIndex = 3 ' Red
Resume SkipCard:
Related
I need some help. I am new to Excel VBA. I am trying to create a userform for stock inventory records and I been geting the automation error -2147467259. My problem is that the code works but after a few mouse clicks (10 or more) or after long usage, I keep getting this error. My code:
Private Sub cbPickID_Change()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim tbl_issuance As ListObject
Set tbl_issuance = shIssuance.ListObjects("tblIssuance")
If Not tbl_issuance.DataBodyRange Is Nothing Then
tbl_issuance.DataBodyRange.Delete
End If
Dim tbl_pick As ListObject
Set tbl_pick = shPickList.ListObjects("tblPickList")
On Error GoTo ErrDetect
With tbl_pick.DataBodyRange
.AutoFilter field:=1, Criteria1:=Me.cbPickID.Value
End With
Dim pick_row As Long
pick_row = shPickList.Range("A" & Application.Rows.Count).End(xlUp).Row
shPickList.Range("A3:L" & pick_row).SpecialCells(xlCellTypeVisible).Copy
shIssuance.Range("A3").PasteSpecial (xlPasteValuesAndNumberFormats)
tbl_pick.AutoFilter.ShowAllData
Application.CutCopyMode = False
Dim issued_row As Long
issued_row = shIssuance.Range("A" & Application.Rows.Count).End(xlUp).Row
With Me.lbPickList
.ColumnHeads = True
.ColumnCount = 12
.ColumnWidths = ("40,40,40,110,0,45,40,60,90,0,0,0")
.RowSource = shIssuance.Range("A3:L" & issued_row).Address
End With
ErrDetect:
If Err.Number = 1004 Then
MsgBox "No records found!"
Exit Sub
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
When I click debug, the error point at this
tbl_issuance.DataBodyRange.Delete
all my reference are in the same file. if I want to use the Excel VBA again, I need to close all Excel file and re-open them again.
any advice is highly appreciated.
This is intended to be a daily macro that run to update a report. This file would need to overwrite the existing file daily. However, the Application.DisplayAlerts = False is not working and I still get the pop up saying that this file already exists and if I want to replace. Is there something wrong with my code or is there a workaround to use a method that would automatically click yes for me?
Sub DailyRefresh ()
'Open and refresh Access
Dim appAccess As Object
Set appAccess = GetObject("S:\Shared\DailyRefresh.accdb")
Application.DisplayAlerts = False
appAccess.Visible = True
appAccess.DoCmd.RunMacro "Run_All_Queries"
appAccess.CloseCurrentDatabase
'Open Excel
Set xl = CreateObject("Excel.Application")
xl.Workbooks.Open ("s:\Shared\Template.xlsx")
xl.Visible = True
Application.DisplayAlerts = False
'Set date to the 1st of the Month on Summary tab
xl.Sheets("Summary").Visible = True
xl.Sheets("Summary").Select
xl.Range("C10").Value = DateSerial(Year(Now), Month(Now), 1)
xl.Range("C10").NumberFormat = "mm/dd/yyyy"
' REFRESH Table
xl.Sheets("Data").Visible = True
xl.Sheets("Data").Select
xl.Range("A1").Select
xl.Range("DailyRefresh.accdb[[#Headers],[ACTIVITY_DT]]").Select
xl.Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
xl.Worksheets("Fname").Visible = True
xl.Sheets("Fname").Select
'Copy and Save AS
Application.DisplayAlerts = False
Path = "S:\Shared\NewTemplate"
Filename = xl.Sheets("Fname").Range("A7").Value
xl.SaveAs Path & Filename & ".xlsx", FileFormat:=51, CreateBackup:=False
xl.Worksheets("Fname").Visible = False
xl.Close
Application.DisplayAlerts = True
End Sub
Application.DisplayAlerts = False
refers to the application where your code is running, not the Excel instance you created.
xl.DisplayAlerts = False
would be what you want.
I propose you to use Application.DisplayAlerts = False exactly before the line(s) that are taking time (no other lines between them). I had the same problem, because I was using it just once, but after each line that calls an external app, when it is back to VBA, it goes back to true.
I am trying to figure out why this "Delete Method of Range Class" error is popping up. It does not always occur when this macro runs, which makes it all the more perplexing.
Can anybody explain this?
Sub ResetSheet()
If WindowsOS Then
'*******************************************************************************************************'
'Resets the Data sheet. Called by the resetSheetButton procedure (located in module: m7_Macros1_5). '
'Also called by the OkCommandButton_Click procedure in the OnOpenUserForm form. '
'*******************************************************************************************************'
Application.EnableEvents = False
Sheet4.Visible = True
Sheet4.Activate
Sheet4.Select
Sheet4.Rows("2:101").Select
Selection.Copy
'TC Edit
Sheet1.Activate
Sheet1.Range("A2").PasteSpecial (xlPasteAll)
'Sheet1.Paste
Sheets("Data").Select
Sheet1.Rows("102:10000").EntireRow.Delete
Sheet4.Visible = False
'TC Edit 2.0 - Adding code to reset the exception checkboxes
If WindowsOS Then
Call resetCheckBoxes
End If
Application.EnableEvents = True
This is the macro code that causes the error (sometimes)
This is the error pop-up
try with below simplified code
Sub ResetSheet()
'If WindowsOS Then
Application.EnableEvents = False
With Worksheets("Sheet4")
.Visible = True
.Rows("2:101").Copy Worksheets("Sheet1").Range("A2")
End With
With Worksheets("Sheet1")
.Rows("102:101").EntireRow.Delete
End With
Worksheets("Sheet4").Visible = False
If windowsOS Then
Call resetCheckBoxes
End If
Application.EnableEvents = True
End Sub
I'm currently trying to delete a worksheet and auto create a new worksheet with the same name.
I'm using the below code. However, when i run the code the windows pop up appears asking me to confirm deletion, i want to prevent this and just delete and replace with a new sheet. I want to avoid Send-keys for this.
ThisWorkbook.Sheets("Process Map").delete
ThisWorkbook.Sheets.Add.Name = "Process Map"
Try setting the DisplayAlerts to False (then back to true if that is what you want as the default setting.
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkBook.Sheets("Process Map").Delete
On Error Goto 0
Application.DisplayAlerts = True
ThisWorkbook.Sheets.Add.Name = "Process Map"
Or without error handling:
Application.DisplayAlerts = False
ThisWorkBook.Sheets("Process Map").Delete
Application.DisplayAlerts = True
ThisWorkbook.Sheets.Add.Name = "Process Map"
I'm building a model that attempts to pull data from the web across different websites using Select All > Copy. Below is the code that I have, and it seems to work in break mode in certain areas, and in other areas it only works when I run the macro.
The portion that is puzzling me at the time is when it hits: "ActiveSheet.PasteSpecial Format:="Text", link:=False, DisplayAsIcon:=False" , it fails and gives me Error 1004 "PasteSpecial method of Worksheet class failed."
On hitting F8 after debugging, the code continues just fine (albeit after showing me "Can't Execute code in break mode 3 times). I've tried altering the code to show "Worksheets("GOOGLE")" and other methods of defining the worksheet directly. My hunch is that may not be the issue. If that's the case, I have no idea what's going on here! Can someone test this out?
FYI I also use a Userform (modeless) on top of this code as a "Waiting" message as it can be quite long to run. Not sure if this is interfering with the paste.
Dim IE As Object
Dim PauseTime, Start
PauseTime = 22 ' Set duration in seconds
Start = Timer ' Set start time.
Application.ScreenUpdating = False
Worksheets("GOOGLE").Activate
Worksheets("GOOGLE").Cells.Clear
Worksheets("GOOGLE").Range("A1").Copy
Application.CutCopyMode = False
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Navigate Range("GOOGLEURL").Value
Do Until .ReadyState = 4: DoEvents: Loop
End With
Do While Timer < Start + PauseTime
DoEvents
Loop
IE.ExecWB 17, 0 '// SelectAll
IE.ExecWB 12, 2 '// Copy selection
ActiveSheet.Range("A1").Select
ActiveSheet.PasteSpecial Format:="Text", link:=False, DisplayAsIcon:=False
IE.Quit
On Error GoTo Ending
IE.Quit
Application.CutCopyMode = False
Ending:
Application.CutCopyMode = False
Exit Sub
Try this method instead of copy/paste between applications. Like you, I tried that and found it unreliable and often didn't work.
You can grab the page's innerText in a string and just use that, or, you could split the innerText in to an array and put that on the sheet, as I do in my example. This preserves the line breaks and makes it a bit more readable than putting all the text in a single cell
I verify this on a simple example (http://google.com) that both methods return the exact same layout of cells in the worksheet.
NOTE: This method may not work when you have the ChromeFrameBHO Add-In installed in IE (see here).
Sub Test()
Dim IE As Object
Dim pageText As String
Dim page As Variant
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Navigate "http://google.com"
Do Until .ReadyState = 4: DoEvents: Loop
End With
pageText = IE.Document.body.innertext
page = Split(pageText, vbCr)
Range("A1").Resize(UBound(page)).Value = Application.Transpose(page)
IE.Quit
Set IE = Nothing
End Sub
Another method which doesn't rely on Internet Explorer is the QueryTables method. It may or may not be appropriate for your needs, but try something like this.
NOTE: This method appears to work (for me) whether the ChromeFrameBHO plugin is installed.
Sub TestQueryTables()
Dim googleURL as String
googleURL = Range("GOOGLEURL")
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & googleURL _
, Destination:=Range("A1"))
.Name = googleURL
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone 'or use xlWebFormattingAll to preserve formats
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
I actually have been struggling with this exact same issue from copy and pasting a bunch of images. Excel 2010 apparently has issues with trying to paste before the copy command is complete. What you can do is a combination of the sleep event and error handling the specific 1004 error. Set up the error handler to catch the 1004 error, and just have it resume. What I did was set up a counter like this:
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
On Error GoTo ErrorHandler:
Dim err_counter As Integer
ErrorHandler:
If Err.Number = 1004 Then
err_counter = err_counter + 1
If err_counter > 10 Then
MsgBox ("The copy function is taking too long. Consider using smaller images.")
Exit Sub
End If
DoEvents
Sleep 500
DoEvents
ElseIf Err.Number <> 0 Then
MsgBox ("Unknown error.")
On Error GoTo 0
Resume
End If
You don't need to use an error counter, but I thoguht it would be a good idea to keep future users of my spreadsheet from somehow creating an infinite loop. I also would clear the clipboard after each image paste, and if you use an error counter, reset it to 0 after a paste is successful.
It looks like you're copying but you're clearing the clipboard before you paste so there's nothing for the code to paste.
Worksheets("GOOGLE").Range("A1").Copy
Application.CutCopyMode = False
Also, are you copying from Sheets("Google").Range("A1") to Sheets("Google").Range("A1")? I don't understand that
I am not in a position to verify my response but I had a similar issue about a year ago. The webpage in question had to use a copy/paste rather than using innertext. It seems you have done most of what I did including pausing waiting or the copy to complete. (Readystate was unhelpful for me.)
The last thing I remember doing, which allowed the code to work, was to place the paste in a finite loop. The paste was typically successful between the third and eighth attempt.
I'm sure there is a better way but was unable to find it. Since my application was for my own use the code was acceptable. As the webpage would change every few months, the code was abandoned.