Hi - I have a macro that will not complete, and I can not figure out why. The
macro is CHECK_for_Sheets_THEN_Copy_DATA:
Sub CHECK_for_Sheets_THEN_Copy_DATA()

'Turning calculationa and screenupdating off for better performance
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim n1 As String

'Copy QTR Data to Credit History
Run [Copy_1QTR_Data_to_CreditHistory_NO_MSG()]
Run [Copy_2QTR_Data_to_CreditHistory_NO_MSG()]
Run [Copy_3QTR_Data_to_CreditHistory_NO_MSG()]
Run [Copy_4QTR_Data_to_CreditHistory_NO_MSG()]

'Saving file as student name and date for backup
Run [SaveAs()]
MsgBox "after SaveAs macro"



'n1 is students name
n1 = Sheets("1").Range("B1").Value
MsgBox "after setting n1 value"

'Check to see if worksheet exists
If WorksheetExists(n1) = True Then
Run [Store_Data_Part_1and2()]
MsgBox "after Store Data macro in If worksheets exist"

Else
MsgBox "the first line after ELSE (worksheet does not exist)"
'Add new sheet at end and name it
Worksheets("Value Template").Visible = True
ThisWorkbook.Worksheets("Value Template").Copy
after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = n1
Worksheets("Value Template").Visible = False
Run [Store_Data_Part_1and2()]
MsgBox "after store data macro in Else, worksheet did NOT exist."

End If

'hide worksheet
'Worksheets(n1).Visible = False

'Activate sheet "Studnet Data Entry"
ThisWorkbook.Worksheets("Studnet Data Entry").Select

'msg box
MsgBox "Data Stored & Workbook saved as " & n1 & "."

'Turning calculation and screen updating back on
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

I have a function, to define "worksheetexist"

Function WorksheetExists(wsName As String) As Boolean
On Error Resume Next
WorksheetExists = Len(Worksheets(wsName).Name) 0

End Function

It all seems to hang up around the SaveAs macro, which is ran from near the
begining. The SaveAs code seems to runs fine by itself. That code is:
Sub SaveAs()
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''
'''' Saves workbook as Students name and Date
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''


''preventing slow response time by turning off screen updating and calculation
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'''''''''''''''''Save To Path Code'''''''''''''''''''''''

Dim sPath As String
Dim f1 As String, f2 As String
'On Error Resume Next 'overcoming the error when a direcory already
exists for MkDir sPath
On Error GoTo Err1:

f1 = Sheets("1").Range("N1").Value
f2 = Sheets("1").Range("B1").Value
sPath = "D:\Ayers My Docs\AHS\AHS Credit Spreadsheets\" & f1 & " " & f2
MsgBox "after sPath in SaveAs"
'MkDir sPath

''''''''''''''''''''''' SaveAs Code '''''''''''''''''''''''''''
ThisWorkbook.SaveAs sPath & "\" & f2 & Format(Now, " mmm-dd-yy hhmmss")

Exit Sub

Err1:
'Directory Does not exist, so create it
MkDir sPath
MsgBox "inside Err1 in sheet 'SaveAs'"

'Go back to the line of code that created the error
Resume

''Turning back on screen updating and calculation
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


End Sub

IMHO you never call SaveAs macro from within
CHECK_for_Sheets_THEN_Copy_DATA macro

though you have:

MsgBox "Data Stored & Workbook saved as " & n1 & "."

as if the SaveAs was called



On 27 Sty, 05:06, Jim A wrote:
Hi - I have a macro that will not complete, and I can not figure out why. The
macro is CHECK_for_Sheets_THEN_Copy_DATA:
Sub CHECK_for_Sheets_THEN_Copy_DATA()

'Turning calculationa and screenupdating off for better performance
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim n1 As String

'Copy QTR Data to Credit History
Run [Copy_1QTR_Data_to_CreditHistory_NO_MSG()]
Run [Copy_2QTR_Data_to_CreditHistory_NO_MSG()]
Run [Copy_3QTR_Data_to_CreditHistory_NO_MSG()]
Run [Copy_4QTR_Data_to_CreditHistory_NO_MSG()]

'Saving file as student name and date for backup
Run [SaveAs()]
MsgBox "after SaveAs macro"

'n1 is students name
n1 = Sheets("1").Range("B1").Value
MsgBox "after setting n1 value"

'Check to see if worksheet exists
If WorksheetExists(n1) = True Then
Run [Store_Data_Part_1and2()]
MsgBox "after Store Data macro in If worksheets exist"

Else
MsgBox "the first line after ELSE (worksheet does not exist)"
* * 'Add new sheet at end and name it
* * Worksheets("Value Template").Visible = True
* * ThisWorkbook.Worksheets("Value Template").Copy
after:=Worksheets(Worksheets.Count)
* * ActiveSheet.Name = n1
* * Worksheets("Value Template").Visible = False
* * Run [Store_Data_Part_1and2()]
* * MsgBox "after store data macro in Else, worksheet did NOT exist."

End If

'hide worksheet
'Worksheets(n1).Visible = False

'Activate sheet "Studnet Data Entry"
ThisWorkbook.Worksheets("Studnet Data Entry").Select

'msg box
MsgBox "Data Stored & Workbook saved as " & n1 & "."

'Turning calculation and screen updating back on
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

I have a function, to define "worksheetexist"

Function WorksheetExists(wsName As String) As Boolean
* * On Error Resume Next
* * WorksheetExists = Len(Worksheets(wsName).Name) 0

End Function

It all seems to hang up around the SaveAs macro, which is ran from near the
begining. The SaveAs code seems to runs fine by itself. That code is:
Sub SaveAs()
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''
'''' Saves workbook as Students name and Date
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''

''preventing slow response time by turning off screen updating and calculation
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'''''''''''''''''Save To Path Code'''''''''''''''''''''''

* * Dim sPath As String
* * Dim f1 As String, f2 As String
* * 'On Error Resume Next * 'overcoming the error when a direcory already
exists for MkDir sPath
* * On Error GoTo Err1:

* * f1 = Sheets("1").Range("N1").Value
* * f2 = Sheets("1").Range("B1").Value
* * sPath = "D:\Ayers My Docs\AHS\AHS Credit Spreadsheets\" & f1 & " " & f2
* * MsgBox "after sPath in SaveAs"
* * 'MkDir sPath

''''''''''''''''''''''' SaveAs Code '''''''''''''''''''''''''''
ThisWorkbook.SaveAs sPath & "\" & f2 & Format(Now, " mmm-dd-yy hhmmss")

Exit Sub

Err1:
* * 'Directory Does not exist, so create it
* * MkDir sPath
* * MsgBox "inside Err1 in sheet 'SaveAs'"

* * 'Go back to the line of code that created the error
Resume

''Turning back on *screen updating and calculation
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Hi Jim,

Un-tested but I wonder if the following is causing a problem.

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

I think it calculates before saving even if calculation is set to manual so
do you have a lot of calculation to be done before saving.

--
Regards,

OssieMac


"Jim A" wrote:

Hi - I have a macro that will not complete, and I can not figure out why. The
macro is CHECK_for_Sheets_THEN_Copy_DATA:
Sub CHECK_for_Sheets_THEN_Copy_DATA()

'Turning calculationa and screenupdating off for better performance
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim n1 As String

'Copy QTR Data to Credit History
Run [Copy_1QTR_Data_to_CreditHistory_NO_MSG()]
Run [Copy_2QTR_Data_to_CreditHistory_NO_MSG()]
Run [Copy_3QTR_Data_to_CreditHistory_NO_MSG()]
Run [Copy_4QTR_Data_to_CreditHistory_NO_MSG()]

'Saving file as student name and date for backup
Run [SaveAs()]
MsgBox "after SaveAs macro"



'n1 is students name
n1 = Sheets("1").Range("B1").Value
MsgBox "after setting n1 value"

'Check to see if worksheet exists
If WorksheetExists(n1) = True Then
Run [Store_Data_Part_1and2()]
MsgBox "after Store Data macro in If worksheets exist"

Else
MsgBox "the first line after ELSE (worksheet does not exist)"
'Add new sheet at end and name it
Worksheets("Value Template").Visible = True
ThisWorkbook.Worksheets("Value Template").Copy
after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = n1
Worksheets("Value Template").Visible = False
Run [Store_Data_Part_1and2()]
MsgBox "after store data macro in Else, worksheet did NOT exist."

End If

'hide worksheet
'Worksheets(n1).Visible = False

'Activate sheet "Studnet Data Entry"
ThisWorkbook.Worksheets("Studnet Data Entry").Select

'msg box
MsgBox "Data Stored & Workbook saved as " & n1 & "."

'Turning calculation and screen updating back on
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

I have a function, to define "worksheetexist"

Function WorksheetExists(wsName As String) As Boolean
On Error Resume Next
WorksheetExists = Len(Worksheets(wsName).Name) 0

End Function

It all seems to hang up around the SaveAs macro, which is ran from near the
begining. The SaveAs code seems to runs fine by itself. That code is:
Sub SaveAs()
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''
'''' Saves workbook as Students name and Date
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''


''preventing slow response time by turning off screen updating and calculation
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'''''''''''''''''Save To Path Code'''''''''''''''''''''''

Dim sPath As String
Dim f1 As String, f2 As String
'On Error Resume Next 'overcoming the error when a direcory already
exists for MkDir sPath
On Error GoTo Err1:

f1 = Sheets("1").Range("N1").Value
f2 = Sheets("1").Range("B1").Value
sPath = "D:\Ayers My Docs\AHS\AHS Credit Spreadsheets\" & f1 & " " & f2
MsgBox "after sPath in SaveAs"
'MkDir sPath

''''''''''''''''''''''' SaveAs Code '''''''''''''''''''''''''''
ThisWorkbook.SaveAs sPath & "\" & f2 & Format(Now, " mmm-dd-yy hhmmss")

Exit Sub

Err1:
'Directory Does not exist, so create it
MkDir sPath
MsgBox "inside Err1 in sheet 'SaveAs'"

'Go back to the line of code that created the error
Resume

''Turning back on screen updating and calculation
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


End Sub

YES, a screenfull of calculations (I'd guess about 100+)
Thanks for looking this LONG post over - JA

"OssieMac" wrote:

Hi Jim,

Un-tested but I wonder if the following is causing a problem.

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

I think it calculates before saving even if calculation is set to manual so
do you have a lot of calculation to be done before saving.

--
Regards,

OssieMac


"Jim A" wrote:

Hi - I have a macro that will not complete, and I can not figure out why. The
macro is CHECK_for_Sheets_THEN_Copy_DATA:
Sub CHECK_for_Sheets_THEN_Copy_DATA()

'Turning calculationa and screenupdating off for better performance
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim n1 As String

'Copy QTR Data to Credit History
Run [Copy_1QTR_Data_to_CreditHistory_NO_MSG()]
Run [Copy_2QTR_Data_to_CreditHistory_NO_MSG()]
Run [Copy_3QTR_Data_to_CreditHistory_NO_MSG()]
Run [Copy_4QTR_Data_to_CreditHistory_NO_MSG()]

'Saving file as student name and date for backup
Run [SaveAs()]
MsgBox "after SaveAs macro"



'n1 is students name
n1 = Sheets("1").Range("B1").Value
MsgBox "after setting n1 value"

'Check to see if worksheet exists
If WorksheetExists(n1) = True Then
Run [Store_Data_Part_1and2()]
MsgBox "after Store Data macro in If worksheets exist"

Else
MsgBox "the first line after ELSE (worksheet does not exist)"
'Add new sheet at end and name it
Worksheets("Value Template").Visible = True
ThisWorkbook.Worksheets("Value Template").Copy
after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = n1
Worksheets("Value Template").Visible = False
Run [Store_Data_Part_1and2()]
MsgBox "after store data macro in Else, worksheet did NOT exist."

End If

'hide worksheet
'Worksheets(n1).Visible = False

'Activate sheet "Studnet Data Entry"
ThisWorkbook.Worksheets("Studnet Data Entry").Select

'msg box
MsgBox "Data Stored & Workbook saved as " & n1 & "."

'Turning calculation and screen updating back on
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

I have a function, to define "worksheetexist"

Function WorksheetExists(wsName As String) As Boolean
On Error Resume Next
WorksheetExists = Len(Worksheets(wsName).Name) 0

End Function

It all seems to hang up around the SaveAs macro, which is ran from near the
begining. The SaveAs code seems to runs fine by itself. That code is:
Sub SaveAs()
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''
'''' Saves workbook as Students name and Date
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''


''preventing slow response time by turning off screen updating and calculation
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'''''''''''''''''Save To Path Code'''''''''''''''''''''''

Dim sPath As String
Dim f1 As String, f2 As String
'On Error Resume Next 'overcoming the error when a direcory already
exists for MkDir sPath
On Error GoTo Err1:

f1 = Sheets("1").Range("N1").Value
f2 = Sheets("1").Range("B1").Value
sPath = "D:\Ayers My Docs\AHS\AHS Credit Spreadsheets\" & f1 & " " & f2
MsgBox "after sPath in SaveAs"
'MkDir sPath

''''''''''''''''''''''' SaveAs Code '''''''''''''''''''''''''''
ThisWorkbook.SaveAs sPath & "\" & f2 & Format(Now, " mmm-dd-yy hhmmss")

Exit Sub

Err1:
'Directory Does not exist, so create it
MkDir sPath
MsgBox "inside Err1 in sheet 'SaveAs'"

'Go back to the line of code that created the error
Resume

''Turning back on screen updating and calculation
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


End Sub

Thanks for looking it over - Jim A

"Jarek Kujawa" wrote:

IMHO you never call SaveAs macro from within
CHECK_for_Sheets_THEN_Copy_DATA macro

though you have:

MsgBox "Data Stored & Workbook saved as " & n1 & "."

as if the SaveAs was called



On 27 Sty, 05:06, Jim A wrote:
Hi - I have a macro that will not complete, and I can not figure out why. The
macro is CHECK_for_Sheets_THEN_Copy_DATA:
Sub CHECK_for_Sheets_THEN_Copy_DATA()

'Turning calculationa and screenupdating off for better performance
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim n1 As String

'Copy QTR Data to Credit History
Run [Copy_1QTR_Data_to_CreditHistory_NO_MSG()]
Run [Copy_2QTR_Data_to_CreditHistory_NO_MSG()]
Run [Copy_3QTR_Data_to_CreditHistory_NO_MSG()]
Run [Copy_4QTR_Data_to_CreditHistory_NO_MSG()]

'Saving file as student name and date for backup
Run [SaveAs()]
MsgBox "after SaveAs macro"

'n1 is students name
n1 = Sheets("1").Range("B1").Value
MsgBox "after setting n1 value"

'Check to see if worksheet exists
If WorksheetExists(n1) = True Then
Run [Store_Data_Part_1and2()]
MsgBox "after Store Data macro in If worksheets exist"

Else
MsgBox "the first line after ELSE (worksheet does not exist)"
'Add new sheet at end and name it
Worksheets("Value Template").Visible = True
ThisWorkbook.Worksheets("Value Template").Copy
after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = n1
Worksheets("Value Template").Visible = False
Run [Store_Data_Part_1and2()]
MsgBox "after store data macro in Else, worksheet did NOT exist."

End If

'hide worksheet
'Worksheets(n1).Visible = False

'Activate sheet "Studnet Data Entry"
ThisWorkbook.Worksheets("Studnet Data Entry").Select

'msg box
MsgBox "Data Stored & Workbook saved as " & n1 & "."

'Turning calculation and screen updating back on
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

I have a function, to define "worksheetexist"

Function WorksheetExists(wsName As String) As Boolean
On Error Resume Next
WorksheetExists = Len(Worksheets(wsName).Name) 0

End Function

It all seems to hang up around the SaveAs macro, which is ran from near the
begining. The SaveAs code seems to runs fine by itself. That code is:
Sub SaveAs()
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''
'''' Saves workbook as Students name and Date
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''

''preventing slow response time by turning off screen updating and calculation
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'''''''''''''''''Save To Path Code'''''''''''''''''''''''

Dim sPath As String
Dim f1 As String, f2 As String
'On Error Resume Next 'overcoming the error when a direcory already
exists for MkDir sPath
On Error GoTo Err1:

f1 = Sheets("1").Range("N1").Value
f2 = Sheets("1").Range("B1").Value
sPath = "D:\Ayers My Docs\AHS\AHS Credit Spreadsheets\" & f1 & " " & f2
MsgBox "after sPath in SaveAs"
'MkDir sPath

''''''''''''''''''''''' SaveAs Code '''''''''''''''''''''''''''
ThisWorkbook.SaveAs sPath & "\" & f2 & Format(Now, " mmm-dd-yy hhmmss")

Exit Sub

Err1:
'Directory Does not exist, so create it
MkDir sPath
MsgBox "inside Err1 in sheet 'SaveAs'"

'Go back to the line of code that created the error
Resume

''Turning back on screen updating and calculation
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub