I'm building a sheet that will change depending on some selections. I have ranges defined that will be used to copy and paste the different data depending on what kind of sheet should get displayed to the user.
Since I built the copy and pasting mechanism, the sheet has been crashing a lot when I run the code to swap the sheet to look differently.
I get "Method 'PasteSpecial' of object 'Range' failed" on my error check and then "Run-time error "-2147417848 (80010108)': Automation error The object invoked has disconnected from its clients." that randomly will occur, sometimes the sheet runs fantastic with no errors and othertimes it is swamped with errors. Usually after this error comes up, I will hit end, and then I'll get a "Microsoft Excel has stopped working" error "windows can try to restart the program". It sometimes recovers but normally not.
I have attempted to copy the cells and paste them without any macros or code and excel has been crashing. I am copy and pasting a bunch of formatted borders and background colours as well as some text that are in the boxes as well.
Public Sub SetupSheetForEquipmentType(equipment As EquipType)
Dim ws As Worksheet
Set ws = Sheets("Input")
Dim info As Worksheet
Set info = Sheets("Info")
Call Unprotect(ws)
ws.Range("selectedEquipType") = equipment
'Normarc Style
'show all rows first
On Error Resume Next
If ws.Rows(14).EntireRow.Hidden = True Then
ws.Rows(14).EntireRow.Hidden = False
ws.Rows(16).EntireRow.Hidden = False
ws.Columns(2).EntireColumn.Hidden = False
End If
On Error GoTo errSec
'setup the sheet
'Application.DisplayAlerts = False
'Application.ScreenUpdating = False
Select Case equipment
Case Is = 2
ws.Range("title") = "ILS PHL7801 MONITOR READINGS"
Case Is = 3
ws.Range("title") = "ILS NORMARC 'A' MONITOR READINGS"
Case Is = 4
ws.Range("title") = "ILS NORMARC 'B' MONITOR READINGS"
End Select
If Not equipment = PHL7801 Then
ws.Rows(24).RowHeight = 15
ws.Rows(25).RowHeight = 15
ws.Columns(3).ColumnWidth = 6
'make the sheet input look appropriate
info.Range("NMSheet").Copy
DoEvents
DoEvents
DoEvents
ws.Range("SheetGuts").PasteSpecial xlPasteAll '************crashes here*********** but works with xlPasteValues
'put the comment box in
info.Range("NMComment").Copy
ws.Range("NMCommentRef").PasteSpecial
ThisWorkbook.Names("comment").Delete
ws.Range("I35").Name = "comment"
End If
Select Case equipment
Case Is = NMA
info.Range("NMACL").Copy
DoEvents
DoEvents
DoEvents
DoEvents
ws.Range("NMCPNames").PasteSpecial xlPasteAllExceptBorders, xlPasteSpecialOperationNone
info.Range("NMADS").Copy
DoEvents
DoEvents
DoEvents
DoEvents
ws.Range("NMDSNames").PasteSpecial xlPasteAllExceptBorders, xlPasteSpecialOperationNone
info.Range("NMARef").Copy
DoEvents
DoEvents
DoEvents
DoEvents
ws.Range("NMRefNames").PasteSpecial xlPasteAllExceptBorders, xlPasteSpecialOperationNone
Case Is = NMB
info.Range("NMBCL").Copy
DoEvents
DoEvents
DoEvents
DoEvents
ws.Range("NMCPNames").PasteSpecial xlPasteAllExceptBorders, xlPasteSpecialOperationNone
info.Range("NMBDS").Copy
DoEvents
DoEvents
DoEvents
DoEvents
ws.Range("NMDSNames").PasteSpecial xlPasteAllExceptBorders, xlPasteSpecialOperationNone
info.Range("NMBRef").Copy
DoEvents
DoEvents
DoEvents
DoEvents
ws.Range("NMRefNames").PasteSpecial xlPasteAllExceptBorders, xlPasteSpecialOperationNone
Case Is = PHL7801
'make the sheet input look appropriate
info.Range("PHLSheet").Copy
DoEvents
DoEvents
DoEvents
ws.Range("SheetGuts").PasteSpecial
'hide the rows that aren't applicable and size them appropriately
ws.Columns(2).Hidden = True
ws.Rows(14).Hidden = True
ws.Rows(16).Hidden = True
ws.Rows(24).RowHeight = 30
ws.Rows(25).RowHeight = 30
ws.Columns(3).ColumnWidth = 10
info.Range("PHLCL").Copy
DoEvents
DoEvents
DoEvents
DoEvents
DoEvents
ws.Range("NMCPNames").PasteSpecial xlPasteAllExceptBorders, xlPasteSpecialOperationNone
info.Range("PHLDS").Copy
DoEvents
DoEvents
DoEvents
DoEvents
ws.Range("NMDSNames").PasteSpecial xlPasteAllExceptBorders, xlPasteSpecialOperationNone
info.Range("PHLRef").Copy
DoEvents
DoEvents
DoEvents
DoEvents
DoEvents
ws.Range("NMRefNames").PasteSpecial xlPasteAllExceptBorders, xlPasteSpecialOperationNone
'put the comment box in
info.Range("PHLComment").Copy
DoEvents
DoEvents
DoEvents
DoEvents
DoEvents
ws.Range("NMCommentRef").PasteSpecial xlPasteAll, xlPasteSpecialOperationNone
ThisWorkbook.Names("comment").Delete
ws.Range("D35").Name = "comment"
End Select
errSec:
If Err.Number <> 0 Then
MsgBox "Error: " & Err.Description
Err.Clear
End If
Call Protect(ws)
'Application.ScreenUpdating = True
'Application.DisplayAlerts = True
End Sub
Edit:
I also have been reading and determined that dumping the temporary files is supposed to help, located here: C:\Users\username\AppData\Local\Temp. Between that and Charles's answer, it seems to be working okay, except I'm getting an error on my catch saying: "To do this, all the merged cells need to be the same size". I am wondering if there is an issue with all the merged cells I have?
Edit Again: I spoke too soon. I noticed that the copy and paste was not working correctly by using the xlpastevalues, so I changed it to xlPasteAll and its now crashing again.
It looks like your missing the paste values
ws.Range("SheetGuts").PasteSpecial xPasteValues
Instead of .Copy and then .PasteSpecial xlPasteAll (and also avoiding the repetitive DoEvents, can you see if this works:
ws.Range("NMRefNames").Unmerge
info.Range("NMSheet").Copy Destination:=ws.Range("NMRefNames")
You may also need to do similar on the next block:
info.Range("NMComment").Copy
ws.Range("NMCommentRef").PasteSpecial
If there are or may be merged cells:
info.Range("NMComment").Copy Destination:=ws.Range("NMCommentRef")
ws.Range("NMCommentRef").Value = ws.Range("NMCommentRef").Value 'Gets rid of formula/etc
Also, for your PasteAllExceptBorders blocks, try doing this on all of them:
info.Range("NMBDS").Copy Destination:=ws.Range("NMDSNames")
ws.Range("NMDSNames").Borders.LineStyle = xlNone
Related
I am having a problem with a macro that copies named ranges and charts out of excel and into powerpoint. The macro functions as intended on my computer, however when when I run the macro on a coworker's computer I get Run-time error '-2147023170 (800706be)'. The problematic loop is below.
'Create an Instance of PowerPoint
On Error Resume Next
'Is PowerPoint already opened?
Set PowerPointApp = GetObject(class:="PowerPoint.Application")
'Clear the error between errors
Err.Clear
'If PowerPoint is not already open then open PowerPoint
If PowerPointApp Is Nothing Then
Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
End If
'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0
Application.ScreenUpdating = False
'Create a New Presentation
Set myPresentation = PowerPointApp.Presentations.Add
'Change aspect ratio
myPresentation.PageSetup.SlideSize = 2
cycle=1
For Each ch In ThisWorkbook.Sheets("Meeting Metrics").ChartObjects
'Add a slide to the Presentation
Set mySlide = myPresentation.Slides.Add(cycle, 11) '11 = ppLayoutTitleOnly
mySlide.Select
With mySlide.Shapes.Title.TextFrame.TextRange
.Text = slideTitles(cycle - 1)
With .Font
.Name = "Arial"
.Size = 32
.Color.RGB = RGB(237, 125, 49)
End With
End With
'Check if there is a table (Excel cell range) to copy for this slide
If Not IsMissing(copyRange(cycle - 1)) Then
'Copy Excel Range
ThisWorkbook.Sheets("Meeting Metrics").Range(copyRange(cycle - 1)).Copy
'Paste to PowerPoint
mySlide.Select
mySlide.Shapes.Paste
Set myShape = mySlide.Shapes(mySlide.Shapes.count)
Application.CutCopyMode = False
'Set position
myShape.Top = tableVertPos(cycle - 1) * 72
myShape.Left = tableHorPos(cycle - 1) * 72
End If
'Copy excel chart
ch.Select
ch.Chart.ChartArea.Copy
'Paste to PowerPoint
mySlide.Select
mySlide.Shapes.Paste
Set myShape = mySlide.Shapes(mySlide.Shapes.count)
Application.CutCopyMode = False
'Set position
myShape.Top = chartVertPos(cycle - 1) * 72
myShape.Left = chartHorPos(cycle - 1) * 72
cycle = cycle + 1
Next
When the error occurs, powerpoint will become unresponsive and ask to close. The error message will pop up, and debug will take me to one of lines containing mySlide (Not always the same line). If I try to hit the continue button, it results in Runtime error 462 since the powerpoint is closed. When I try to step through the program on the other computer to find the problematic line, it will step through a couple lines and then run like normal until it bugs out. However, if a throw a line break somewhere inside the loop and manually iterate it or put a message box inside the loop, the code will run fine.
I've tried inserting wait or sleep into the loop to see if this helps, but this just causes the code to halt for a few seconds before failing.
There appears to be a bug in the system described as a 'run ahead' in some places. I've had some success with the following ugly workaround...
Create the following UglyWait subprocedure
Sub UglyWait(Optional sec As Integer = 1)
Dim future As Date
future = DateAdd("s", sec, Now())
Do While Now() < future
DoEvents
Loop
End Sub
Place a call to UglyWait before and after any Powerpoint goto, paste, or save operations.
Application.Wait doesn't work, nor does a standard single DoEvents. This does seem to help though.
I have a macro that checks if some names on column Q appear on column A (which is ordered alphabetically) and prints them out on column S if they do. However, every time I run it it freezes after an undefined amount of iterations (never on the same amount of iterations) so it's really hard to know what's going on. If I run it with a breaking point and press F5 for each iteration it doesn't freeze, the thing is I have thousands of names to compare and I really don't want to press F5 that many times.
Here's my code:
Sub test()
Range("Q2").Select
analizados = 0
falsos = 0
Do Until IsEmpty(ActiveCell)
id1 = ActiveCell.Value
primera = Left(id1, 1)
Range("A2").Select
Do While Not ActiveCell.Value Like "" & primera & "*"
ActiveCell.Offset(1, 0).Select
Loop
Do While ActiveCell.Value Like "" & primera & "*"
If id1 = ActiveCell.Value Then
Range("S2").Select
ActiveCell.Offset(falsos, 0).Select
ActiveCell.Value = id1
falsos = falsos + 1
Exit Do
End If
ActiveCell.Offset(1, 0).Select
Loop
analizados = analizados + 1
Range("Q2").Select
ActiveCell.Offset(analizados, 0).Select
Loop
End Sub
Thank you
As you noticed, it's not actually frozen. It's just that Excel can't keep up with updating the screen as fast as you're bombarding it with "something has changed on the active sheet" events, and at one point it gives up and lets the macro complete without bothering with refreshing - at least that's how I understand it (might not be exactly what's going on though).
Try this:
Sub Test()
On Error GoTo ErrHandler
Application.ScreenUpdating = False
'...
'(rest of your code)
'...
CleanExit:
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume CleanExit
End Sub
Basically you tell Excel to not even bother with repainting itself until you're done: this should greatly speed up your loops.
You may want to combine this with different settings for Application.Calculation and Application.Cursor, too; and for a better UX you could use the status bar to tell the user to wait a little:
Sub Test()
On Error GoTo ErrHandler
Application.StatusBar = "Please wait..."
Application.ScreenUpdating = False
'...
'...
CleanExit:
Application.StatusBar = False
Application.ScreenUpdating = True
Exit Sub
I have the following code that loads a worksheet in full screen for 1 minute, and then moves onto the next worksheet in the workbook, using the exactly the same methodology.
This is to show stats on a big screen, looping through several stats pages.
This works perfectly on Excel 2007 and 2010.
Yet when the same code is executed on Excel 2013, Excel simply maxes out 1 core of my CPU and stays at not responding. I cannot even Escape to break the code execution. Stepping through the code line by line works fine on all versions.
'Loads up Daily Dispatch Figures worksheet
Application.ScreenUpdating = False
Sheets("Daily Dispatch Figures").Select
Range("A1").Select
Range("A1:C36").Select
ActiveWindow.Zoom = True
Range("A1").Select
ActiveWindow.DisplayHeadings = False
Application.DisplayFormulaBar = False
Application.DisplayFullScreen = True
Application.ScreenUpdating = True
' Stays on this screen for 1 min
TimVal = Now + TimeValue("0:01:00")
Do Until Now >= TimVal
Loop
Ooo, don't do this:
' Stays on this screen for 1 min
TimVal = Now + TimeValue("0:01:00")
Do Until Now >= TimVal
Loop
Try this:
Application.OnTime Now + TimeValue("0:01:00"), "ProcedureToRun"
You don't want to catch your application in an infinite loop with no sleeps.
Any time you sit in an infinite loop without sleeping, it will use 100% of your Processor time doing nothing. Application.OnTime "schedules" an event and returns control to the Excel UI Thread instead of infinitely looping.
You can read more here: https://msdn.microsoft.com/en-us/library/office/ff196165.aspx
I'm not sure what you're doing after your loop, but you need to make sure you have the code in a separate subroutine and call it.
Here is a Subroutine to go to the next sheet.
Sub MoveNext()
On Error Resume Next
Sheets(ActiveSheet.Index + 1).Activate
If Err.Number <> 0 Then Sheets(1).Activate
On Error Goto 0
End Sub
You can add the Application.OnTime to the end of it and have it call itself:
Sub MoveNext()
On Error Resume Next
Sheets(ActiveSheet.Index + 1).Activate
If Err.Number <> 0 Then Sheets(1).Activate
On Error Goto 0
Application.OnTime Now + TimeValue("00:01:00"), MoveNext
End Sub
This way it will loop and go from sheet to sheet forever (or until you stop it in whatever method you choose to use).
Finally, you can cancel this by storing the scheduled time and using Scheduled:=False.
Your final code could look something like this:
Public scheduledTime as Date
Sub StartDisplaying()
'Your start code:
'---------------------------------------------
Application.ScreenUpdating = False
Sheets("Daily Dispatch Figures").Select
Range("A1").Select
Range("A1:C36").Select
ActiveWindow.Zoom = True
Range("A1").Select
ActiveWindow.DisplayHeadings = False
Application.DisplayFormulaBar = False
Application.DisplayFullScreen = True
Application.ScreenUpdating = True
'---------------------------------------------
scheduledTime = Now + TimeValue("00:01:00")
Application.OnTime scheduledTime, MoveNext
End Sub
Sub StopDisplaying()
'Your stop code:
'---------------------------------------------
Application.ScreenUpdating = False
Sheets("Daily Dispatch Figures").Select
ActiveWindow.Zoom = False
ActiveWindow.DisplayHeadings = True
Application.DisplayFormulaBar = True
Application.DisplayFullScreen = False
Application.ScreenUpdating = True
'---------------------------------------------
Application.OnTime EarliestTime:=scheduledTime, Procedure:="MoveNext", Schedule:=False
End Sub
Sub MoveNext()
On Error Resume Next
Sheets(ActiveSheet.Index + 1).Activate
If Err.Number <> 0 Then Sheets(1).Activate
On Error Goto 0
scheduledTime = Now + TimeValue("00:01:00")
Application.OnTime scheduledTime, MoveNext
End Sub
I have this consolidation macro which opens, copies and pastes data from one sheet of several workbooks onto a master sheet where such data as well as workbooks maybe in the thousands. Overall this process will take anywhere from 30mins to an hour and I thought a progress bar would help.
I got the code i used for the consolidation part here at stackoverflow. It was somebody with a similar issue, however, the progress bar code i got somewhere else. I had to jury-rig the code of sorts to fit it for my needs.. The examples online uses a for next loop code for the progress bar which mine doesn't.
i tried running my code but the progress bar doesn't update.. T_T
can somebody help me with what's wrong with my code?
Any help on this is very much appreciated.. thanks..
Sub OpeningFiles()
Dim SelectedFiles As FileDialog
Dim NumFiles As Long, FileIndex As Long
Dim TargetBook As Workbook
Dim sName, sName2, sName3 As Range
Dim pctCompl As Single
Set sName = ThisWorkbook.Sheets("Sheet1").Range("j1")
Set SelectedFiles = Application.FileDialog(msoFileDialogOpen)
With SelectedFiles
.AllowMultiSelect = True
.Title = "Pick the files you'd like to consolidate:"
.ButtonName = ""
.Filters.Clear
.Filters.Add ".xlsx files", "*.xlsx"
.Show
End With
If SelectedFiles.SelectedItems.Count = 0 Then Exit Sub
NumFiles = SelectedFiles.SelectedItems.Count
For FileIndex = 1 To NumFiles
Set TargetBook = Workbooks.Open(SelectedFiles.SelectedItems(FileIndex), ReadOnly:=True)
Application.DisplayAlerts = False
ActiveWorkbook.Activate
Sheets(sName).Activate
On Error GoTo 0
Range("d11:j11").Select
Range(Selection, Selection.End(xlDown)).Copy
ThisWorkbook.Sheets("Sheet1").Activate
Range("b2").Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
ActiveCell.PasteSpecial Paste:=xlPasteValues
ThisWorkbook.Application.CutCopyMode = False
TargetBook.Close SaveChanges:=False
Next FileIndex
progress pctCompl
MsgBox ("Consolidation complete!")
End Sub
Sub progress(pctCompl As Single)
UserForm1.Text.Caption = pctCompl & "% Completed"
UserForm1.Bar.Width = pctCompl * 2
DoEvents
End Sub
Sub ShowProgress()
UserForm1.Show
End Sub
Addendum:
This code
Sheets(sName).activate
selects the sheetname of the opened file wherein it is always a number from 1-30. Right now, I have to indicate that number one at a time. Is there a way to do it like 3 or 7 times? like a loop? e.g 1-7 or 25-27.. It is always ascending so i thought a code like the one below will work? Thoughts?
For sName = sNameStart To sNameEnd Step 1
Sheets(sName).Activate
On Error GoTo 0
Range("d11:j11").Select
Range(Selection, Selection.End(xlDown)).Copy
ThisWorkbook.Sheets("Sheet1").Activate
Range("b2").Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
ActiveCell.PasteSpecial Paste:=xlPasteValues
ActiveWorkbook.Activate
Next sName
where sName is the sheet name, sNameStart is the start sheet and sNameEnd is the end sheet.
However, i get this error when I start this code.. Help?
You need to move your call to progress pctCompl inside your loop.
The code you posted doesn't call progress pctCompl until after Next FileIndex
ThisWorkbook.Application.CutCopyMode = False
TargetBook.Close SaveChanges:=False
Next FileIndex
progress pctCompl
MsgBox ("Consolidation complete!")
Replace it with this:
ThisWorkbook.Application.CutCopyMode = False
TargetBook.Close SaveChanges:=False
'insert your command here
progress pctCompl
Next FileIndex
MsgBox ("Consolidation complete!")
If you need something more precise than progress bar try putting:
Application.StatusBar = "File " & FileIndex & " of " & NumFiles
somewhere within For..Next loop, I like this because it is more verbose than just progress bar.
And remember to put
Application.StatusBar = False
After your loop to restore standard status bar.
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.