Macro NOT completing

J

Jim A

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
 
J

Jarek Kujawa

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



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
Click to expand...
 
O

OssieMac

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 said:
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
Click to expand...
 
J

Jim A

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

OssieMac said:
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 said:
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
Click to expand...
Click to expand...
 
J

Jim A

Thanks for looking it over - Jim A

Jarek Kujawa said:
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



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
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Making a macro only work on certain files 2
printing to XPS and saving XPS "as" 0
Remove Identical words 0
Word macro that can call cells out of Excel for a find and replace 0
VBA Coding Help for Beginner 0
macros run twice - why 2
MACRO Effeciency 3
Adjust macro 0

Top