I have an Excel workbook in which almost everything is automated. It opens other workbooks, copies data from them, closes them and then loops through the data several times to generate reports that we print and use. Almost every time after running all the VBA and then trying to print, print preview gets stuck either finding the printer or loading page sizes as seen in the picture. Closing Excel and reopening the document restores print preview to normal functionality. The only thing related to printing that the VBA does is change the print area. I have not had this issue with any other documents that run VBA. Is this just a bug or possibly something in the code?
This is the code that causes print preview to fail to load in some way. If I skip this section then it works as intended... I would like to have this code function in some way as it's still needed.
Set wb1 = Workbooks.Open(FileName)
Set wb2 = ThisWorkbook
For i = LBound(sArray) To UBound(sArray) 'Loops through array, copies available data from last report
ShtName = sArray(i, 0)
On Error Resume Next
wb1.Sheets(ShtName).Activate
If Err.Number = 0 Then
wb1.Sheets(ShtName).Activate
Columns("A:U").Copy
wb2.Sheets(ShtName).Activate
Columns("BE:BV").Select
Selection.PasteSpecial xlPasteValues
Application.CutCopyMode = False
lastrow = Cells(Rows.Count, "BE").End(xlUp).Row
Range("BA2:BC2").Select
Selection.AutoFill Destination:=Range(Cells(2, "BA"), Cells(lastrow, "BC")), Type:=xlFillDefault
End If
On Error GoTo 0
DoEvents
Next i
wb1.Close False
Sheet2.Activate
I've tried commenting out "On Error Resume Next", "On Error Goto 0", "If...", "End If", and "DoEvents". Print Preview still fails with those removed and just doing the copy and paste from the previous sheet.
It seems that removing all instances of DoEvents has fixed the issue...
Print Preview works correctly and Excel does not crash when exiting the workbook anymore.
I believe you're looking for some type of refresh action that can re-sync the preview display with the data on the sheet. You might want to try this at the end:
ActiveSheet.EnableCalculation = False
ActiveSheet.EnableCalculation = True
If that doesn't work, see if manually saving fixes the issue. You can try calling Application.Save at the end.
"Print preview occurs automatically when you choose File --> Print. Another option is to use the Page Layout view (the icon on the right side of the status bar). To get the old-style print preview, you need to use VBA. The following statement displays a print preview of the active sheet: ActiveSheet.PrintPreview "
Quoted from Microsoft Excel 2013 Power Programming with VBA by John Walkenbach, pages 956-957.
That being said, I tested your issue above by recording a relatively complex macro that creates a new sheet, performs 25 automatic actions, and shows a print preview, then closes the print preview when I click OK on a MsgBox. I iterated the program to do this 1000 times. I never had an issue with the PrintPreview.
Its kind of a shot in the dark, but I tried cleaning up your code a little bit. See if that has any affect at all.
Sub Test()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim isWS As Boolean
On Error GoTo sub_err
Set wb1 = Workbooks.Open(Filename)
Set wb2 = ThisWorkbook
For i = LBound(sArray) To UBound(sArray) 'Loops through array, copies available data from last report
ShtName = sArray(i, 0)
isWS = True
Set ws1 = wb1.Sheets(ShtName)
If isWS Then
Set ws2 = wb2.Sheets(ShtName)
ws1.Columns("A:U").Copy
ws2.Columns("BE:BV").PasteSpecial xlPasteValues
Application.CutCopyMode = False
lastrow = ws2.Cells(ws2.Rows.Count, "BE").End(xlUp).Row
ws2.Range("BA2:BC2").AutoFill Destination:=ws2.Range(ws2.Cells(2, "BA"), ws2.Cells(lastrow, "BC")), Type:=xlFillDefault
End If
DoEvents
Next i
wb1.Close False
ws2.Activate
sub_exit:
Exit Sub
sub_err:
If Err.Number = 9 Then
isWS = False
Resume Next
Else
MsgBox "Error: " & Err.Number & vbNewLine & Err.Description
Resume sub_exit
End If
End Sub
The big thing I did was split off your error handling, this way it only resumes next when you don't find the sheet in wb1 and all other errors (none error 9 errors) will still show your error message.
I also made sure all your Range(), Cells(), and Columns() were referencing the correct sheet (just incase excel is getting confused) and I assumed the active sheet was the correct sheet, but you may want to verify this in the code to make sure it's doing the correct thing in the correct sheet.
Now the copy code only runs if isWS = true, and it will always be true unless an error 9 code is thrown. The only thing I didn't know was if wb2 would always have a sheet name equal to ShtName but I'm guessing it will since it's inside your if err.number = 0
I'm not sure if this will change anything for you, but I'd be curious to hear your results other way.
Related
I am working on creating a macro to simplify things that I do on a daily basis. The idea behind this macro is to copy 7 worksheets from the parent report, open a new workbook, paste and hardcode the data, save it to my desktop and close the new workbook.
As I am working through debugging and testing my code I am running into a problem which I do not understand why it is happening. If I boot up windows and run the macro the first time in my excel workbook, I get no issues the first time I run it for the 7 reports. The problem comes up when I try to add code or fix issues and run the code again. I keep getting " Run-time error '1004' Application-defined or object defined error".
I am trying to debug and when I hit F8 for debugging and stepping into the code, it seems it gets hung up around step #4 when it is trying to close when I run it more than once. I am learning and using Leila Gharani's course, but I don't think I got this far in the course yet to understand. If someone can please help me so I can understand this concept, I would greatly appreciate it.
Thank you
'1. Select Parent Report and select BD Tab
Workbooks("Parent Report").Activate
Worksheets("BD").Select
'2. Select all cells from BD tab, open new workbook , paste data, and hardcode it.
Cells.Select
Cells.Copy
Workbooks.Add
Range("A1").PasteSpecial xlPasteAll
Cells.Select
Cells.Copy
Range("A1").PasteSpecial xlPasteValues
Cells.EntireRow.AutoFit
'3. Rename worksheet to BD and cell "A2" to BD.
ActiveWorkbook.ActiveSheet.Name = "BD"
Range("A2").Value = "BD"
Range("A1").Select
'4. Save current flash report to local drive, with monthly naming format and close it.
ActiveWorkbook.SaveAs "C:\Users\mylocaldriveinfo\Desktop\Flash Reports" & "\BD Monthly Reporting - Preliminary " & Format(Date, "mmm") & " " & Format(Date, "yyyy")
ActiveWorkbook.Close
I just figured it out. It was my one drive at work giving me an issue. I disabled it, as I never use it and doing so I have not been able to replicate the error.
I am sure this code isn't best practice, but it works for now.
Option Explicit
Sub CopySheets()
Const FOLDER = "C:\Users\mylocaldriveinfo\Desktop\Flash Reports\BD Monthly Reporting -"
Dim wbNew As Workbook, wbMaster As Workbook, sht, n As Long
Set wbMaster = ThisWorkbook
' create new workbook
Set wbNew = Workbooks.Add(1) ' 1 sheet
n = 1
For Each sht In Array("BD", "Sheet2", "Sheet3", "Sheet4", _
"Sheet5", "Sheet6", "SHeet7") ' 7 sheet names
wbMaster.Sheets(sht).Copy After:=wbNew.Sheets(n)
n = n + 1
With wbNew.Sheets(n)
.UsedRange.Value = .UsedRange.Value
.Range("A2") = sht
End With
Next
With wbNew
' delete blank sheet
Application.DisplayAlerts = False
.Sheets(1).Delete
Application.DisplayAlerts = True
' save
.SaveAs Filename:=FOLDER & Format(Date, "mmm yyyy")
.Close
End With
MsgBox "Done", vbInformation
End Sub
I have written a pretty elaborate code to automate 2 hours of work into less than 1 min. It works, on most days, somedays like today, the code wont work, or parts of the code wont work.
Its the most obviously simple parts of the code that doesn't work.
This is frustrating me.
To get the code to work, what I have to do would be to restart the system.
Please understand, I dont change the code at all. either before or after the error happens.
the is the code, where the error happens.
Range("Table1_2[[#Headers],[Bag No]:[Batch Making]]").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Batch Making").Delete
Sheets.Add(After:=Sheets("Sheet1")).Name = "Batch Making"
Range("A1").Select
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit
Today the error was that it would not paste what the code had selected.
please note:
It selected the set of rows and columns
It created the new sheet and selected the first cell
It tried pasting the value also, but nothing happened.
After restarting the system, code worked like a dream.
Why does this happen?? any clue ??
EDIT: Biggest issue is replicating the error, as I mentioned on some days, the code will crash, else it will run smoothly.
Every day new data is fed to the program, and its cleaned to ensure that only what the program can take is given to it and this involves removing #N/A's, #VALUE's and #Ref (this was done today also, I double checked the data after the crash)
Yet at times it fails.
I'll remove the Error Handlers and have separate code to check for availability of sheet, incase the error pop's up again, then I'll update here.
You can try below code. Using select is not the best idea in 99% of time. Also, when referencing a cell it is always good to precisely tell VBA which worksheet to use.
I would suggest to replace on error resume next clause - it disables all errors in your code and you will not be notified if something went wrong.In this case you can write a bit more code to check whether the specific worksheet exist and then remove/add it.
Sub copytable()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("worksheet_with_table_you_want_to_copy")
On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.Worksheets("Batch Making").Delete
ThisWorkbook.Sheets.Add(After:=Sheets("Sheet1")).Name = "Batch Making"
Application.DisplayAlerts = True
ws.ListObjects(1).Range.Copy
With ThisWorkbook.Worksheets("Batch Making")
.Range("a1").PasteSpecial xlPasteAll
.Cells.EntireColumn.AutoFit
End With
End Sub
edit: Code without on error but with check wheather worksheet "Batch Making" exists and delete it if it's true
Sub copytable()
Dim wsTable As Worksheet
Set wsTable = ThisWorkbook.Worksheets("worksheet_with_table_you_want_to_copy")
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Batch Making" Then ThisWorkbook.Worksheets("Batch Making").Delete
Next ws
Application.DisplayAlerts = True
ThisWorkbook.Sheets.Add(After:=Sheets("Sheet1")).Name = "Batch Making"
ws.ListObjects(1).Range.Copy
With ThisWorkbook.Worksheets("Batch Making")
.Range("a1").PasteSpecial xlPasteAll
.Cells.EntireColumn.AutoFit
End With
End Sub
Unfortunately, you don't say what your code is supposed to do but it seems that you have a template and try to create a new worksheet with a table from this template.
The problem is that the source isn't qualified. Your code copies a "Table_2" from an unspecified source sheet, then deletes the "Batch Making" tab, creates a new sheet by that name and pastes the clipboard to this new sheet. The process is slightly illogical because if the source is a sheet by the name of "Batch Making" then it takes a lot of confidence to delete the original before the copy is safely in place. But I think you have a template. Therefore there is no danger of losing data but the question arises why you make the copy before you need it. Either way, if the copy on the clipboard is lost while deleting and inserting sheets "nothing will happen", as you say.
But what should happen? I presume that you just get a fresh copy of the template, and that means that you retain the structure of the table. Therefore my code below takes a radically different approach. It doesn't delete a sheet (with the table in it) and doesn't create a new sheet. Instead it simply deletes the content of the table in the existing sheet.
Sub Snippet()
' 295
Const WsName As String = "Batch Making"
Dim Ws As Worksheet ' Sheets(WsName)
Dim Tbl As ListObject
On Error Resume Next
Set Ws = Worksheets(WsName)
If Err Then
MsgBox "Sorry, there is no tab """ & WsName & """ in this workbook.", _
vbInformation, "Missing worksheet"
Else
Set Tbl = Ws.ListObjects(1)
If Err Then
MsgBox "Sorry, there is no table on the specified worksheet.", _
vbInformation, "Missing table"
Else
Tbl.DataBodyRange.ClearContents
End If
End If
End Sub
This is done by a single line of code, to wit, Tbl.DataBodyRange.ClearContents. You could take more or different action at that point. For example, you could delete unwanted rows or add default cell content. If there is a lot of such default you might get those data (or formulas) from a template. Otherwise just add it to the code. Headers and totals aren't deleted. The table's structure remains unchanged.
Before that, in the above code, the sheet is qualified and the table. In place of the error messages you could insert code to create the tab and/or create the table.
Please observe the name of the worksheet at the top of the code. You can change that string to any other name. The code doesn't specify the name of the table. Instead, it presumes that there is only one table on that sheet and clears that one.
I have some code that is copying a upwards of 1K files or so from a network drive to a SharePoint site. When it has completed that task, It calls the following sub. When I step through the code it seems to work fine, and it worked fine on some of the smaller lists I uploaded. However when I just let it run it magically stops executing code and behaves as if everything has successfully been executed. I know it hasn't because The workbook I picked to be open is still open and the workbook I am running the code from is blank.
The best I can surmise is the code stops executing right around:
SourceWB.Sheets("Sheet1").Activate
Because the destination sheet is still blank, I am pretty sure the cells.copy is not executing. The only other thing I can think of is it somehow is grabbing the Destination worksheet as the source work sheet, so nothing actually gets copied and I wind up with a blank sheet. I rule that out though as at the end of my main sub a message box is supposed to appear when things are complete and no message box appears.
Can anyone spot an issue or shed some light on what may be happening. Frustrating that it works when stepping through. (as long as there is a break point afterwards)
Sub ImportIndex()
'Copies Sheet1 from a user selected workbook
'into current work book
Dim DestinationWS As Worksheet
Dim DestinationR As Range
Dim SourceWB As Workbook
Dim FilenameWB As String
'clear sheet1 of any previous data/formats etc
Clear_Worksheet ("Sheet1")
'Set the location of where the sheet is to be copied to
Set DestinationWS = ThisWorkbook.Sheets("Sheet1")
Set DestinationR = DestinationWS.Range("A1")
'Open the source workbook through file picker
'****************************************************************
'Error may occur if workbook is already open
'Look into how to deal with this in the future
'****************************************************************
FilenameWB = Application.GetOpenFilename()
Set SourceWB = Workbooks.Open(Filename:=FilenameWB)
'Ensure "sheet1" is the active worksheet
SourceWB.Sheets("Sheet1").Activate
'Copies active wrokesheet to Destination
Cells.Copy DestinationR
'close the source workbook without saving changes
SourceWB.Close savechanges:=False
End Sub
I did look at the following question, but it was related to Word. According to one comment, the most recent build seems to have solved their issue.
Clearworksheet function as requested
Sub Clear_Worksheet(Sheetname As String)
'Deletes all cells in the provide worksheet name
'currently will cause an error if the sheet does not exist
With ThisWorkbook.Sheets(Sheetname)
.Cells.Delete Shift:=xlUp
Range("A1").Activate 'probably do no need this activate
End With
End Sub
I just re ran the code with the elimination of ACTIVATE and also having removed all stepping break points. I also changed the copy line to 'SourceWB.Sheets("Sheet1").Cells.Copy` as suggested. The code still stopped executing after opening the sheet and before copying the sheet to Thisworkbook.
on a side note, I also notice sometimes while stepping through the code and I do a file pick or folder pick, the code seems to terminate unless I have a break point set somewhere slightly after it.
I've commented that not sure why it would stop... having a wild guess it could be because of the very large range you're copying (the whole sheet...).
You should either set the range of what you are copying (cell 1 to last row/column), or in this case, since you are not adding to pre-existent data, could be better off to just copy the sheet.
See if rewriting your code this way would help?
Sub ImportIndex()
'Copies Sheet1 from a user selected workbook
'into current work book
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim SourceWB As Workbook
Dim FilenameWB As String
'Open the source workbook through file picker
On Error Resume Next
FilenameWB = Application.GetOpenFilename()
Set SourceWB = Workbooks.Open(Filename:=FilenameWB)
On Error GoTo 0
If Not SourceWB Is Nothing Then
'ws.Name = "something else" 'rename this if you want to keep "Sheet1" name from the source workbook
SourceWB.Sheets("Sheet1").Copy After:=ws
ws.Delete
'close the source workbook without saving changes
SourceWB.Close savechanges:=False
Else
'Some error handling here... msgbox/debug.print etc
End If
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
PS: Note that there are various ways to handle opening a workbook, but for simplicity reasons, this should work just fine.
When the code below reaches the .Delete instruction it goes into an endless loop. When stopped in the Task Manager an error message "Automation error" is displayed. When the Debug button in the error message is pressed the .Delete line is highlighted. The sheet isn't deleted. The alert message isn't displayed.
Sub DeleteXlTable(Wb As Workbook, _
Frm As fTextLib)
' SSY 047 ++ 30 Dec 2018
Dim LibWs As Worksheet
Dim Rng As Excel.Range
' Application.DisplayAlerts = False
Set LibWs = SetLibWs(Wb, Frm)
With LibWs
If .ListObjects.Count = 1 Then
If Wb.Worksheets.Count = 1 Then
With .UsedRange
.Columns.Delete
.Rows.RowHeight = 12.75
End With
.Name = "Sheet1"
Else
.Delete
End If
Else
Set Rng = .ListObjects(Frm.CbxTbl.Text).Range
Do While Rng.Row > NwsFirstLibRow
If Not .Cells(Rng.Row - 1, NwsKey).ListObject Is Nothing Then Exit Do
Set Rng = Rng.Offset(-1).Resize(Rng.Rows.Count + 1)
Loop
Rng.Rows.EntireRow.Delete
End If
End With
Application.DisplayAlerts = True
End Sub
The code is called in a VBA project embedded in MS Word. The Excel application is called properly and available. The Worksheet exists and is accessible at the time of the error. I tried replacing the line with the full object's name, Wb.Worksheets(LibWs.Name).Delete, with the same result. I tried deleting the ListObject before deleting the sheet. The table was deleted but the same error occurred on the next line.
Similar code run from a stand-alone Excel application works perfectly, even if the deleted sheet is the active one. I wonder whether I should save the workbook before deleting the sheet but don't know why that should make a difference. Any ideas what I might do?
Per our earlier conversation, it seems as if the alert in Excel in causing an issue.
Add:
Wb.Parent.DisplayAlerts = False
Where:
Application.DisplayAlerts = False
was commented out.
I'm having a problem that I don't really know how to fix. I have a code that runs perfectly in Windows 7 Excel 2010 and always has. In the last few weeks it has developed an error but only when running in Windows 10 Excel 2013.
Basically the below code copies some data sheets to a new workbook in order to strip the VBA out (as this is blocked by company filters). It then loops through all the objects and names and deletes them before sending it via Outlook
Private Sub btnSend_Click()
'---------------------Create the email spreadsheet---------------------------------
Dim FName As String
Dim FPath As String
Dim NewBook As Workbook
Dim EEName As String
Dim nm As Name
EEName = Range("ForeNameCell").Value & " " & Range("SurnameCell").Value
FPath = VBA.Environ("temp") & "\" 'file path to store the copy of the sheet
FName = "NS Form - " & EEName & " " & VBA.Format(VBA.Now(), "mm_dd_yyyy hh mm AMPM")
Set NewBook = Workbooks.Add 'create a new workbook
ThisWorkbook.Sheets("contract Print Out").Copy Before:=NewBook.Sheets(1) 'copy over the printoutallfields sheet
ThisWorkbook.Sheets("Oracle Data").Copy Before:=NewBook.Sheets(1) 'copy over the printoutallfields sheet
'copy and paste special data in new workbook to remove formula
NewBook.Sheets("contract Print Out").Cells.Copy
NewBook.Sheets("contract Print Out").Cells.PasteSpecial xlPasteValues
NewBook.Sheets("Oracle Data").Cells.Copy
NewBook.Sheets("Oracle Data").Cells.PasteSpecial xlPasteValues
'remove back buttons
Dim myshape As Shape
For Each myshape In NewBook.Sheets("contract Print Out").Shapes
myshape.Delete
Next myshape
For Each myshape In NewBook.Sheets("Oracle Data").Shapes
myshape.Delete
Next myshape
'remove links and named ranges
Application.Calculation = xlManual
On Error Resume Next
For Each nm In NewBook.Names
nm.Delete ' This line now errors in W10 E2013
Next
On Error GoTo 0
Application.Calculation = xlCalculationAutomatic
'NewBook.Sheets("PrintOutallFields").Name = "User Data" 'rename it in the destination workbook
Application.DisplayAlerts = False 'turn off overwrite prompt so that it will just overwrite
NewBook.SaveAs Filename:=FPath & FName 'save the file
DoEvents
Application.DisplayAlerts = True 'turn overwrite prompt back on
NewBook.Close
The error that appears is below and when I query the name it is trying to delete it comes up with #NAME?. Every single name seems to appear this way to the code as when I skip ahead and try to go to the next nm, the same thing happens.
I forgot to mention the reason we delete the names from the workbook is due to them always referring the original file. This causes issues when we receive it as the original would of course, always be on the customers PC.
My guess is MS in their eternal wisdom, pushed an update which breaks VBA between versions ... AGAIN! I've had to fix a few of these already but I am stumped by this one.
It seems that my Windows profile had a corruption somewhere. The file also worked on other Windows 10 installations around the office. Re-installing Excel did not fix it, but rebuilding my Windows profile did. This is a first for me, and I thought I had seen everything already.
I would like to thank everyone who looked into this. I'm sure if this were a normal issue with Excel, the enumeration suggestion would have been spot on.