I have a very odd duck problem with Excel VBA. I have a data file that is opened in VBA, written to and then closed. I have three separate worksheets within this same file that are similar but not the same, but none of them contain shapes, or other objects and relatively small amounts of data (usually less than 1000 rows by no more than 30 columns -- mostly numeric constant values) are being pasted into these worksheets. When two of the sheets are modified, it saves lickety split with no issues, but the third worksheet takes in excess of one minute to complete the save operation. The preceding code is almost exactly the same.
Set WBs = ThisWorkbook
Set WSs = WBs.Worksheets("SourceData")
LastRow = WSs.Range("B" & Rows.Count).End(xlUp).Row 'Finds row number of last row of data
Set WBd = OpenWorkbook(FileNam, FullPath:=True)
Set WSd = WBd.Worksheets("TroubledWorksheet")
''' CODE FOR COPYING DATA '''
Set Rng = WSs.Range("A20:AJ" & LastRow + 1)
WSd.Range("A2:AJ" & LastRowD).Clear
Rng.Copy WSd.Range("A2") 'copies all data from source to dest file
WSs.Columns("A:AI").Copy 'copy column width from source
WSd.Columns("A:AI").PasteSpecial Paste:=xlPasteColumnWidths 'paste column width to dest
ActiveWindow.DisplayZeros = False 'hides zeros in cells if formulas output is zero
WSd.Cells.FormatConditions.Delete 'clears Conditional Formatting for entire Sheet
WBd.Activate
WSd.Select
WSd.Range("A1").Select
Application.CalculateBeforeSave = False
' WBd.Save
WBd.Close SaveChanges:=True
Application.CalculateBeforeSave = True
I have uncommented the .Save in the above code with the same effect. I have also removed the .CalculateBeforeSave flags being set, also with no difference.
OpenWorkbook is a helper function that I use to open all of my workbooks.
''' ***************************************************************************
''' * OpenWorkbook()
''' * Preconditions: None
''' * Input: fname - File name
''' * show - boolean to show the workbook after opening
''' * FullPath - Boolean saying wheter it is partial or full path to wb
''' * Readonly - To open as Read Only or not
''' * Output: The Workbook Object
''' * This returns a workbook object of the specified file name. Checks to see
''' * if the Workbook is already open
''' ***************************************************************************
Public Function OpenWorkbook(fname As String, _
Optional show As Boolean = True, _
Optional FullPath As Boolean = False, _
Optional ReadOnly As Boolean = False, _
Optional UpdateLinks As Boolean = False, _
Optional AutoSave As Boolean = False) As Workbook
Dim wb As Workbook
Dim myFileName As String
Dim wbPath As String
Dim aPath() As String
On Error GoTo OpenWorkbookError
'If GEN_DEBUGGING Then Debug.Print "Enter OpenWorkbook @" & TimeInMS
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
wbPath = IIf(FullPath, fname, ReturnPath(fname))
If Right(wbPath, 4) Like "*xls*" Then
myFileName = wbPath
ElseIf Left(fname, 1) = "\" Or Left(fname, 1) = "/" Then
myFileName = wbPath & Mid(fname, 2) 'SelectFile(wbPath)
Else
myFileName = wbPath & fname
End If
On Error Resume Next
aPath = Split(myFileName, Delimeter)
Set wb = Workbooks(aPath(UBound(aPath)))
If wb Is Nothing Then Set wb = Workbooks.Open(myFileName, UpdateLinks:=UpdateLinks, ReadOnly:=ReadOnly)
On Error GoTo OpenWorkbookError
If wb Is Nothing Then
Err.Raise vbObjectError + 514, "Helper.OpenWorkbook", _
"Unable to Open " & myFileName & " Workbook"
Exit Function
Else
On Error Resume Next
wb.AutoSaveOn = AutoSave
On Error GoTo OpenWorkbookError
wb.Windows(1).Visible = show
End If
Set OpenWorkbook = wb
OpenWorkbookExit:
Application.DisplayAlerts = True
On Error GoTo 0
Exit Function
OpenWorkbookError:
MsgBox "Please ensure the workbook you are trying to open is at the specified location: " & _
vbCrLf & fname, vbCritical + vbOKOnly, "Error Opening Workbook"
HandleError "Helper.OpenWorkbook()"
Resume OpenWorkbookExit
End Function
This slow save for only one of the sheets has been observed by other members of my company. I have tried to pause the code before the save and save the workbook manually with the same result of a very prolonged save. Once I have saved it the first time it resumes normal behavior and saves quickly either in code or in the Excel application.
Any pointers or help would be greatly appreciated.
EDIT 1: I've updated the code for more completeness
EDIT 2: There was a similar post here: Too long saving time in Excel via VBA but it resolved itself. The problem I am experience is taking longer and longer. Today it took 11 minutes to save the file. The hangup is only on the .Save everything runs like clockwork right up until that point.
EDIT 3: It appears that some of the time it is now saving quickly and at other times it has continued to act slowly. There is no rhyme or reason behind these differences that I can pinpoint, they all occur when the data file was already created and previously saved, but other than that I am stumped.
EDIT 4: Resurrecting this post because this is becoming a rather serious slow-down in the operation. This behavior is only for Sheet(1) of the 3-sheet workbook, if I save to the other two sheets, this problem is non-existent. If I create a fresh workbook in code (a common occurrence) this problem does not happen, it is only when the data on Sheet(1) is replaced by the new data that we see this problem. Hopefully someone out there has seen something like this.
