After running almost the entire macro, Excel stops working

[David_Blue]

Hello,

I have written a macro to update hidden master tables, update names, refresh formulas and formatting, and it works great - thanks in part to help I received here. My problem is that the workbook is not running the macro properly and fully on one computer when run on opening (a prompt calls the macro when the workbook opens), but gets through almost all the code before an error screen pops up "Microsolf Excel has stopped working....."

It works fine on my computer and on another office computer, just not on this one in this scenario. Also, I've had it work successfully when run from Alt+F8.

As today is Monday, the macro displays "Please take some time...." as it should and then "Microsoft Excel...."

Any thoughts? Would love some assistance as this is a critical worksheet.


Sub Refresh_Tables()
'
' Refresh the Tables and Names
'


'
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Application.EnableEvents = False ' for testing
'ActiveSheet.DisplayPageBreaks = False ' for later testing

' Find the spot that the user was at, so that they will be returned there again when the macro is done

Dim Cell_spot As String
Dim WB_Spot As String
Dim Sheet_Spot As String
Dim LastDataRow As Long
Dim LastBlankRow As Long
Dim FirstCalcColumn As Long
Dim LastCalcColumn As Long
Dim rngMyCell As Range


Cell_spot = ActiveCell.Address
Sheet_Spot = ActiveSheet.Name
WB_Spot = ActiveWorkbook.Name

If Sheet_Spot = "Cntrl" Then
MsgBox "Please select a sheet with data on it, not 'Cntrl' or 'Notes' and close and reopen the workbook" _
& " so that the update runs. When closing down your timesheet, remember to be in a data sheet."
GoTo errHandler ' just in case the user closes the workbook in "Cntrl" or "Notes"
End If
If Sheet_Spot = "Notes" Then
MsgBox "Please select a sheet with data on it, not 'Cntrl' or 'Notes' and close and reopen the workbook" _
& " so that the update runs. When closing down your timesheet, remember to be in a data sheet."
GoTo errHandler ' just in case the user closes the workbook in "Cntrl" or "Notes"
End If




' Delete All Named Ranges except the Print Ranges so that any Named Ranges accidentally
' added by the user are wiped, and that all Named Ranges are as defined in the Timesheet
' Tables.

Dim wbBook As Workbook
Dim nName As Name
Set wbBook = ActiveWorkbook

For Each nName In wbBook.Names
If InStr(1, nName.Name, "Print") > 0 Then

Else
nName.Delete
End If
Next nName


'Sheets("Notes").Delete -two alternates to try instead of code below.
'Sheets(Array("Notes", "Blank_Mo", "Employees", "Hrly Rates", "Fixed Rates", "Billing Types", "Source_Stratas", _
"Source_Blueprint", "Companies", "Projects", "Meetings", "Contracts", "Filtered")).Delete

Sheets("Notes").Visible = True
Sheets("Notes").Select
ActiveWindow.SelectedSheets.Delete

Sheets("Blank_Mo").Visible = True
Sheets("Blank_Mo").Select
ActiveWindow.SelectedSheets.Delete


Sheets("Employees").Visible = True
Sheets("Employees").Select
ActiveWindow.SelectedSheets.Delete

Sheets("Hrly Rates").Visible = True
Sheets("Hrly Rates").Select
ActiveWindow.SelectedSheets.Delete

Sheets("Fixed Rates").Visible = True
Sheets("Fixed Rates").Select
ActiveWindow.SelectedSheets.Delete

Sheets("Billing Types").Visible = True
Sheets("Billing Types").Select
ActiveWindow.SelectedSheets.Delete

Sheets("Source_Stratas").Visible = True
Sheets("Source_Stratas").Select
ActiveWindow.SelectedSheets.Delete

Sheets("Source_Blueprint").Visible = True
Sheets("Source_Blueprint").Select
ActiveWindow.SelectedSheets.Delete

Sheets("Companies").Visible = True
Sheets("Companies").Select
ActiveWindow.SelectedSheets.Delete

Sheets("Projects").Visible = True
Sheets("Projects").Select
ActiveWindow.SelectedSheets.Delete


Sheets("Meetings").Visible = True
Sheets("Meetings").Select
ActiveWindow.SelectedSheets.Delete


Sheets("Contracts").Visible = True
Sheets("Contracts").Select
ActiveWindow.SelectedSheets.Delete

Sheets("Filtered").Visible = True
Sheets("Filtered").Select
ActiveWindow.SelectedSheets.Delete

Dim Cur_WB As String
Cur_WB = ActiveWorkbook.Name

Workbooks.Open Filename:="X:\4.0 Time Tracking\_Masters\Master Timesheet Tables - 2017.xlsm"

' Sort the Projects Table so that the Projects are in Company / Project Name Order
' If we want to add this to the refresh process, here is where we would add it.


' This next section copies the sheets with the Master Tables into the active timesheet


Sheets(Array("Notes", "Blank_Mo", "Employees", "Hrly Rates", "Fixed Rates", "Billing Types", "Source_Stratas", _
"Source_Blueprint", "Companies", "Projects", "Meetings", "Contracts", "Filtered")).Select
Sheets(Array("Notes", "Blank_Mo", "Employees", "Hrly Rates", "Fixed Rates", "Billing Types", "Source_Stratas", _
"Source_Blueprint", "Companies", "Projects", "Meetings", "Contracts", "Filtered")).Copy After:=Workbooks( _
Cur_WB).Sheets(Workbooks(Cur_WB).Sheets.Count)
' Application.Wait (Now + TimeValue("0:00:01"))

' Create copies of the Named Ranges from "Timesheet Tables" into the active Timesheet
' Workbook so that the Names used are always the Names from the Timesheet Tables,
' which should help keep everything tight.

For Each nName In Workbooks("Master Timesheet Tables - 2017.xlsm").Names
Workbooks(Cur_WB).Names.Add Name:=nName.Name, RefersToR1C1:=nName.RefersToR1C1
Next nName

Windows("Master Timesheet Tables - 2017.xlsm").Close

Workbooks(Cur_WB).Activate



' Leave the Notes sheet visible so that users can reference it quickly


' Sheets(Array("Blank_Mo", "Employees", "Hrly Rates", "Fixed Rates", "Billing Types", "Source_Stratas", _
"Source_Blueprint", "Companies", "Projects", "Meetings", "Contracts", "Filtered")).Visible = False
' Sheets("Notes").Visible = False 'don't actually want to hide this sheet, included in list for completeness
Sheets("Blank_Mo").Visible = False
Sheets("Employees").Visible = False
Sheets("Hrly Rates").Visible = False
Sheets("Fixed Rates").Visible = False
Sheets("Billing Types").Visible = False
Sheets("Source_Stratas").Visible = False
Sheets("Source_Blueprint").Visible = False
Sheets("Companies").Visible = False
Sheets("Projects").Visible = False
Sheets("Meetings").Visible = False
Sheets("Contracts").Visible = False
Sheets("Filtered").Visible = False

Workbooks(WB_Spot).Activate
Sheets(Sheet_Spot).Select
Range(Cell_spot).Select

' This section is to go through the current month's worksheet and do the maintenance required to keep the data solid.


' Check how many unused rows remain - if less than 100, add 100 rows.


Sheets(Sheet_Spot).Select
LastDataRow = Cells(Rows.Count, "E").End(xlUp).Row
LastBlankRow = Cells(Rows.Count, "A").End(xlUp).Row


If LastBlankRow - LastDataRow < 100 Then
Sheets("Blank_Mo").Range("A4").EntireRow.Copy
Sheets(Sheet_Spot).Select
Range("A4").End(xlDown).Offset(1, 0).EntireRow.Select
Range(ActiveCell, ActiveCell.Offset(100, 0)).Rows.Insert Shift:=xlDown
'Application.Wait (Now + TimeValue("0:00:01"))
Application.CutCopyMode = False
End If


' Replace all the calculation columns in the current timesheet month


' Replace the formulas below the gray header section


Range("L2").Select
FirstCalcColumn = ActiveCell.Column
LastCalcColumn = ActiveCell.End(xlToRight).Column


Sheets("Blank_Mo").Visible = True
Sheets("Blank_Mo").Select
Sheets("Blank_Mo").Range(Cells(3, FirstCalcColumn), Cells(3, LastCalcColumn)).Copy
Sheets("Blank_Mo").Visible = False
Sheets(Sheet_Spot).Select

Range(Cells(3, FirstCalcColumn), Cells(ActiveCell.End(xlDown).Row, LastCalcColumn)).Select
ActiveSheet.Paste
Application.CutCopyMode = False


' Replace the formulas in the first four columns on an individual basis (after checking each to see if its been overridden)


Application.ScreenUpdating = False 'Duplicated here to see if it will actually prevent screen flashing for this section.

Sheets("Blank_Mo").Range("A4").Copy Range("A4:A" & LastBlankRow)
Application.CutCopyMode = False


For Each rngMyCell In Range("B4:B" & LastBlankRow)
If rngMyCell.HasFormula Then


rngMyCell.Formula = Replace(Sheets("Blank_Mo").Range("B4").Formula, "B4", "B" & rngMyCell.Row)

End If
Next rngMyCell

Application.CutCopyMode = False


For Each rngMyCell In Range("D4:D" & LastBlankRow)
If rngMyCell.HasFormula Then


rngMyCell.Formula = Replace(Sheets("Blank_Mo").Range("D4").Formula, "D4", "D" & rngMyCell.Row)

End If
Next rngMyCell

Application.CutCopyMode = False



' Replace all the Conditional Formatting


Cells.FormatConditions.Delete
Sheets("Cntrl").Select
Sheets("Blank_Mo").Visible = True
Sheets("Blank_Mo").Range("A3").EntireRow.Copy
Sheets(Sheet_Spot).Select
Rows("3:3").Select
Range("A3", Cells(LastBlankRow, 1)).EntireRow.Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'Application.Wait (Now + TimeValue("0:00:01"))
Sheets("Blank_Mo").Visible = False
Application.CutCopyMode = False
Sheets(Sheet_Spot).Select
Range(Cell_spot).Select


If Weekday(Now()) = 2 Then MsgBox ("Please take some time to resolve all of your current Red Status items.")
'Application.Wait (Now + TimeValue("0:00:03"))

errHandler:

Application.Calculation = xlCalculationAutomatic
MsgBox "1"
Application.ScreenUpdating = True
MsgBox "2"
Application.DisplayAlerts = True
MsgBox "3"
Application.EnableEvents = True
MsgBox "4"
'Application.DisplayPageBreaks = True
Exit Sub

End Sub

Thank You,
Dave

 

[David_Blue]

I added the "1", "2", "3", "4" just before posting and ran it now - I can confirm that it successfully displayed "4", so basically something is going on on this specific computer between MsgBox "4" and the end of the macro.

I've read about one solution of giving the macro time to work by adding a Application.Wait line for a few seconds if it doing heavy duty calculations - i've got that commented out currently, will reactivate and try.

 

[David_Blue]

No Luck on the 3 second delay to allow it to catch up.

 

[David_Blue]

If I run the macro after opening the workbook and declining to run it when prompted, it runs successfully. This makes me think that something in the code that calls this macro is causing Excel the culprit here - perhaps the call itself is just resource hungry enough to make Excel stop working? I am using Excel 2010 and the version is Home & Business. The macro that calls the macro above is:

Private Sub Workbook_Open()


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Dim answer As Integer


answer = MsgBox("Would you like to refresh the Tables for this Timesheet?", vbYesNo + vbQuestion, "Refresh Tables")


If answer = vbYes Then


Run "Refresh_Tables"

Else
'do nothing
End If


Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


End Sub

This macro is located the ThisWorkbook.

Thanks again all,

Dave

 

[jackirby]

I am encountering a similar problem that literally started two days ago on a set of Macros that had been working successfully for two years. Did Microsoft push an update that is causing this to break? I'll be monitoring this thread to see if any of the experts can shed some light.