VBA Windows 10 code crashes excel when executing. Works when stepping through. Runs on Windows 7 fine.

[goldbeck09]

Hi all,

I have the code below that loops through data and saves off many workbooks based on criteria given in the code. Fairly simple process...just copying/pasting data/sheets and saving workbooks. The code crashes excel (sometimes on the first loop or sometimes after a few workbooks have been saved). The code works on Windows 10 if you step through the code. I also have a remote desktop Windows 7 machine that I've tested the code on and works on execution mode as well as stepping through. Any thoughts to what is causing the code to crash? I have other modules on my Windows 10 machine that run fine, so it is something about the code below!

Public contact As String
Public subject As String
Public mypath As String

Sub ValuePaster()





'  Workbooks(filetemplatename).Sheets("Summary").Activate

Dim CostCenter As String
    Dim fileTemplatepath As String
        Dim filetemplatename As String
            Dim filecostcenter As String
                Dim group As String
                    Dim FileName As String
                        Dim division As String
                            Dim owner As String
Dim costcenters As String
    Dim wb1 As String
        Dim xsheets As Integer
            Dim xindex As Integer
                Dim i As Long
                    Dim ws As Worksheet
                        Dim lr As Long
                            

Dim pt As PivotTable


With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
End With

filetemplatename = ThisWorkbook.Name
fileTemplatepath = ThisWorkbook.FullName
Workbooks(filetemplatename).Sheets("cc's").Activate
Set counter = Range("counter")
Range("counter").Value = Range("startcounter") 'cell f2


Application.Calculate


'Start Loop Here
'
'
'
Do Until counter = Range("endcounter") 'cell g2

group = Range("group")
owner = Range("owner")
FileName = Range("filename")
division = Range("division")

Set counter = Range("counter")
startcounter = Range("startcounter")
endcounter = Range("endcounter")
costcenters = Range("costcenters")

mypath = Range("mypath")
contact = Range("contact")
subject = Range("subject")


'IF Group = YES then ' this is if the management report will have multiple cost centers
'
'
'
If group = "YES" Then

ThisWorkbook.Sheets.Copy
    Set wbnew = ActiveWorkbook
        wbnew.SaveAs ThisWorkbook.Path & "\" & FileName
        Application.Wait (Now + TimeValue("0:00:10"))
 wb1 = ActiveWorkbook.Name


    
'Loop by using x as the index number to make x number copies.
'Replace "Sheet1" with the name of the sheet to be copied.

xsheets = costcenters
        For i = 1 To xsheets - 1
            Sheets("Summary").Copy before:=Sheets(1)
                 Next
    
        
'Now rename each sheet to a specific cost center
    xinteger = Sheets("summary").Index
    
        For i = 1 To xinteger
            Workbooks(wb1).Worksheets(i).Activate
'           activeworkbok.Sheets(i).Activate
            
            Workbooks(wb1).Sheets(i).Calculate
 '           activeworkbok.Worksheets(i).Calculate
            
                If ActiveSheet.Name = "Consolidated" Then Exit For
                Range("e3") = Sheets("cc's").Range("c5")
                     Worksheets(i).Calculate
            
                         ActiveSheet.Name = Range("E3")
                           
                             Workbooks(wb1).Sheets("cc's").Range("counter").Value = Workbooks(wb1).Sheets("cc's").Range("counter").Value + 1
                             Worksheets("CC's").Calculate
                                  Next
' Workbooks(filetemplatename).Sheets("cc's").Range("counter").Value = counter + xsheets

'Move the sheets between first:last sheets
        Do
            i = 1
                Worksheets(i).Activate
                    If ActiveSheet.Name = "Consolidated" Then Exit Do
                        Worksheets(i).Move before:=Worksheets("last")
                            Loop




'ending the If statement above "if group = "yes" then goto Group begin
GoTo GroupBegin

End If



'If "No" then the macro will START HERE

ThisWorkbook.Sheets.Copy
Set wbnew = ActiveWorkbook
wbnew.SaveAs ThisWorkbook.Path & "\" & FileName



'Group Begin
GroupBegin: 'If the current workbook is a grouping, start macro again here

'wbnew.SaveAs "FY18 Budget Summary " & CostCenter, FileFormat:=xlOpenXMLWorkbook
Application.Calculate

If Sheets.Count <= 8 Then 'If the sheet count is equal to or less than 9 then we would delete consolidated/first/last as it would be a single cost center template
    filecostcenter = ActiveWorkbook.Name
        Workbooks(filecostcenter).Sheets("summary").Activate
            Workbooks(filecostcenter).Sheets("Summary").Name = Range("e3")
                   Sheets(Array("consolidated", "first", "last")).Delete
                        End If

filecostcenter = ActiveWorkbook.Name



'''''''''''''''''''


'fileCostCenter.Activate
Workbooks(filecostcenter).Activate

'Application.Calculate


For Each Worksheet In Workbooks(filecostcenter).Worksheets ' Selects visible sheets only and pastes values only
        Worksheet.Activate
        If ActiveSheet.Name <> "CC's" Then
        ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
        End If
            Next Worksheet

        
        ''deleting the code below and trying a more simpler method above
'        Do
'          a = 1
'         If Worksheet.Visible = False Then Exit Do
'             Worksheet.Activate
'
'             If ActiveSheet.Name <> "CC's" Then
'
'            ' On Error Resume Next
'                 ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
'                    End If
'                     a = a + 1
'                         Loop Until a = 2
'                            Next Worksheet
                 
For Each Sheet In ActiveWorkbook.Sheets ' Deletes all non-visible sheets
    If Sheet.Visible = False Then Sheet.Delete
     Next Sheet

'
'Z = 1
'
'Do
'    ActiveWorkbook.Sheets(Z).Activate
'      Z = Z + 1
'         Loop Until ActiveSheet.Name = "NOT USED" _
'             Or ActiveSheet.Index = Sheets.Count

ActiveWorkbook.Sheets("NOT USED").Activate
Do

    If ActiveSheet.Index = Sheets.Count Then Exit Do
     If ActiveSheet.Name = "NOT USED" Then y = ActiveSheet.Index
       For Each Sheet In ActiveWorkbook.Sheets
         If Sheet.Index >= y Then Sheet.Delete
             Next Sheet
Loop

'If ActiveSheet.Name = "NOT USED" Then ActiveSheet.Delete

'Application.DisplayAlerts = True ' Turns back on the delete y/n confirmation dialog box

Application.CutCopyMode = False ' Deactivates cut/copy function so it's not waiting to paste copied data

For Each Worksheet In ActiveWorkbook.Worksheets ' Selects cell A1 on all sheets to deactivate highlighting
    Worksheet.Activate
    Range("A1").Select
    Next Worksheet
''''

LineLabel8:

        '   ActiveWindow.DisplayOutline = False 'Hides all outline marks
'            ActiveWindow.View = xlNormalView
'            ActiveWindow.FreezePanes = False

   ' Next Worksheet
    
    
    
    
'
'Worksheets(1).Select
'Range("A1").Select
'ActiveWindow.WindowState = xlMaximized ' Maximizes the active window

'For Each Button In ActiveSheet.Buttons ' Deletes all buttons on the active sheet
'    Button.Delete
'    Next Button

'The following deletes the first sheet in the model if it is called "InputVariables".
'The sheets by that name in our current models are of no use to clients, so the macro
'deletes them since the intention of the model is to produce a document for client
'review.  If the first sheet is named something other than "InputVariables",it is not
'deleted - this is so the macro can be applied to other models in which the first sheet
'should not be deleted.
   ' Application.DisplayAlerts = False 'Turns off the page deletion dialog box
'    Worksheets(1).Select
'    If ActiveSheet.Name = "InputVariables" Then ActiveSheet.Delete
'    Worksheets(1).Select
'    Range("A1").Select
  '  Application.DisplayAlerts = True 'Turns back on the page deletion dialog box
  
  

'Range("A1").Select ' Select the upper left cell of the inputs sheet to give the macro an orderly end.


Application.CutCopyMode = False


On Error Resume Next
Sheets(Array("first", "last")).Delete
Sheets(1).Activate


'''''''''''''''''''''''''''''''''''''



'Call groupme
Call Edit




If Sheets.Count = 2 Then
Sheets("consolidated").Delete
End If

Sheets(1).Activate
Range("a1").Activate
Application.Goto ActiveCell, True

Application.DisplayAlerts = False

SaveAgain:
On Error GoTo SaveAgain
'Workbooks(filecostcenter).Save
ActiveWorkbook.Save
Application.Wait (Now + TimeValue("0:00:15"))
Workbooks(filecostcenter).Close


filecostcenter = vbNullString


'''''''''''''''''Call email



Workbooks(filetemplatename).Sheets("cc's").Activate

Set counter = Range("counter")
startcounter = Range("startcounter")
endcounter = Range("endcounter")


If xsheets = 0 Then
     Range("Counter").Value = counter + 1
        Workbooks(filetemplatename).Sheets("cc's").Calculate

        Else
            Range("Counter").Value = counter + xsheets
                Workbooks(filetemplatename).Sheets("cc's").Calculate

End If


xsheets = 0

Loop 'Ends counter loop

Workbooks(filetemplatename).Sheets("Summary").Activate

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With

Dim Msg6, Style6, Title6, Response6
    Msg6 = "Pasting complete."    ' Define message.
    Style6 = vbOKOnly ' Define buttons.
    Title6 = "V A L U E  P A S T E R"
    Response6 = MsgBox(Msg6, Style6, Title6)

LineLabelEnd: ' Inserted as an alternative target for the previous GoTo function

End Sub

 

[DanteAmor]

On which line of the macro is the execution stopped?
What does the error message say?