macros run twice - why

J

Jim A

Hi - I have been working on some Macros. I am compiling a macro that runs
other macros. I have two noticeable problems.

1 - My SaveAs macro runs fine by itself. But when called or ran by another
macro, (which calls more than one macro) the SaveAs macro it stops.

2- Many of my macros, when ran by another macro (which runs more than one
macro) cycles through twice.

My specific question is about no. 2 and the following are the individual
macros and the macro that runs them.

Sub Store_Data_to_ValueSheets_Part1()
'''''This macro copies values from sheets 1, 2, 3, 4, and Credit
History''''''''
''''' NOT TO BE RUN INDEPENDENTLY - FOR THERE MUST EXIST A FOLDER
(n1)''''''''''''

MsgBox "inside StoreData Part1 macro"

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

'setting Dim
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
Dim wsch As Worksheet
Dim Nws As Worksheet
Dim n1 As String

'n1 is students name
n1 = Sheets("1").Range("B1").Value

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

'defining variable to worksheets
Set ws1 = ThisWorkbook.Sheets("1")
Set ws2 = ThisWorkbook.Sheets("2")
Set ws3 = ThisWorkbook.Sheets("3")
Set ws4 = ThisWorkbook.Sheets("4")
Set wsch = ThisWorkbook.Sheets("Credit History")
Set Nws = ThisWorkbook.Sheets(n1)

''''''''''''''''''''''''''Copy Code'''''''''''''''''''''''''''''''''''''
Dim i As Long, j As Long, k As Long
k = 0
j = 0
For i = 1 To 10

'copy values for sheets 1
Nws.Range("A2:A44").Offset(, j).Value = _
ws1.Range("E5:E47").Offset(, k).Value

'copy values for sheets 2
Nws.Range("P2:p44").Offset(, j).Value = _
ws2.Range("E5:E47").Offset(, k).Value

'copy values for sheets 3
Nws.Range("A46:A88").Offset(, j).Value = _
ws3.Range("E5:E47").Offset(, k).Value

'copy values for sheets 4
Nws.Range("P46:p88").Offset(, j).Value = _
ws4.Range("E5:E47").Offset(, k).Value

k = k + 3
j = j + 1

Next i


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

MsgBox "completed part1"

End Sub

THE OTHER -

Sub Store_Data_to_ValueSheets_Part2()
'''''This macro copies values from sheets 1, 2, 3, 4, and Credit
History'''''''
''''' NOT TO BE RUN INDEPENDENTLY - FOR THERE MUST EXIST A FOLDER
(n1)''''''''''''

MsgBox "inside StoreData Part2 macro"

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

'setting Dim
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
Dim wsch As Worksheet
Dim Nws As Worksheet
Dim n1 As String

'n1 is students name
n1 = Sheets("1").Range("B1").Value

'hide worksheet
Worksheets(n1).Visible = False

'defining variable to worksheets

Set ws1 = ThisWorkbook.Sheets("1")
Set ws2 = ThisWorkbook.Sheets("2")
Set ws3 = ThisWorkbook.Sheets("3")
Set ws4 = ThisWorkbook.Sheets("4")
Set wsch = ThisWorkbook.Sheets("Credit History")
Set Nws = ThisWorkbook.Sheets(n1)

'copy parts of sheets 1, 2, 3 and 4 that did not fit parameters above
Dim m As Long, n As Long
m = 0
For n = 1 To 2

'copy part of sheet 1
Nws.Range("K2:K44").Offset(, m).Value = _
ws1.Range("AI5:AI47").Offset(, m).Value
Nws.Range("M2:M44").Offset(, m).Value = _
ws1.Range("AL5:AL47").Offset(, m).Value

'copy part of sheet 2
Nws.Range("Z2:Z44").Offset(, m).Value = _
ws2.Range("AI5:AI47").Offset(, m).Value
Nws.Range("AB2:AB44").Offset(, m).Value = _
ws2.Range("AL5:AL47").Offset(, m).Value

'copy part of sheet 3
Nws.Range("K46:K88").Offset(, m).Value = _
ws3.Range("AI5:AI47").Offset(, m).Value
Nws.Range("M46:M88").Offset(, m).Value = _
ws3.Range("AL5:AL47").Offset(, m).Value

'copy part of sheet 4
Nws.Range("Z46:Z88").Offset(, m).Value = _
ws4.Range("AI5:AI47").Offset(, m).Value
Nws.Range("AB46:AB88").Offset(, m).Value = _
ws4.Range("AL5:AL47").Offset(, m).Value

m = m + 1
Next n

''''copy value back to sheets Credit History'''''
Nws.Range("A90:X132").Value = _
wsch.Range("D6:AA48").Value

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

MsgBox "completed part 2"

End Sub

This is the macro that runs them -

Sub Store_Data_Part1_and_2()

Run [Store_Data_to_ValueSheets_Part1()]

Run [Store_Data_to_ValueSheets_Part2()]

End Sub


Thanks for any help - Jim A
 
S

Shane Devenshire

Hi,

You say the SaveAs macro works fine but executes twice. I don't see any
code for a saveas macro? In fact I don't see any command to execute a save?

--
If this helps, please click the Yes button

Cheers,
Shane Devenshire


Jim A said:
Hi - I have been working on some Macros. I am compiling a macro that runs
other macros. I have two noticeable problems.

1 - My SaveAs macro runs fine by itself. But when called or ran by another
macro, (which calls more than one macro) the SaveAs macro it stops.

2- Many of my macros, when ran by another macro (which runs more than one
macro) cycles through twice.

My specific question is about no. 2 and the following are the individual
macros and the macro that runs them.

Sub Store_Data_to_ValueSheets_Part1()
'''''This macro copies values from sheets 1, 2, 3, 4, and Credit
History''''''''
''''' NOT TO BE RUN INDEPENDENTLY - FOR THERE MUST EXIST A FOLDER
(n1)''''''''''''

MsgBox "inside StoreData Part1 macro"

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

'setting Dim
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
Dim wsch As Worksheet
Dim Nws As Worksheet
Dim n1 As String

'n1 is students name
n1 = Sheets("1").Range("B1").Value

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

'defining variable to worksheets
Set ws1 = ThisWorkbook.Sheets("1")
Set ws2 = ThisWorkbook.Sheets("2")
Set ws3 = ThisWorkbook.Sheets("3")
Set ws4 = ThisWorkbook.Sheets("4")
Set wsch = ThisWorkbook.Sheets("Credit History")
Set Nws = ThisWorkbook.Sheets(n1)

''''''''''''''''''''''''''Copy Code'''''''''''''''''''''''''''''''''''''
Dim i As Long, j As Long, k As Long
k = 0
j = 0
For i = 1 To 10

'copy values for sheets 1
Nws.Range("A2:A44").Offset(, j).Value = _
ws1.Range("E5:E47").Offset(, k).Value

'copy values for sheets 2
Nws.Range("P2:p44").Offset(, j).Value = _
ws2.Range("E5:E47").Offset(, k).Value

'copy values for sheets 3
Nws.Range("A46:A88").Offset(, j).Value = _
ws3.Range("E5:E47").Offset(, k).Value

'copy values for sheets 4
Nws.Range("P46:p88").Offset(, j).Value = _
ws4.Range("E5:E47").Offset(, k).Value

k = k + 3
j = j + 1

Next i


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

MsgBox "completed part1"

End Sub

THE OTHER -

Sub Store_Data_to_ValueSheets_Part2()
'''''This macro copies values from sheets 1, 2, 3, 4, and Credit
History'''''''
''''' NOT TO BE RUN INDEPENDENTLY - FOR THERE MUST EXIST A FOLDER
(n1)''''''''''''

MsgBox "inside StoreData Part2 macro"

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

'setting Dim
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
Dim wsch As Worksheet
Dim Nws As Worksheet
Dim n1 As String

'n1 is students name
n1 = Sheets("1").Range("B1").Value

'hide worksheet
Worksheets(n1).Visible = False

'defining variable to worksheets

Set ws1 = ThisWorkbook.Sheets("1")
Set ws2 = ThisWorkbook.Sheets("2")
Set ws3 = ThisWorkbook.Sheets("3")
Set ws4 = ThisWorkbook.Sheets("4")
Set wsch = ThisWorkbook.Sheets("Credit History")
Set Nws = ThisWorkbook.Sheets(n1)

'copy parts of sheets 1, 2, 3 and 4 that did not fit parameters above
Dim m As Long, n As Long
m = 0
For n = 1 To 2

'copy part of sheet 1
Nws.Range("K2:K44").Offset(, m).Value = _
ws1.Range("AI5:AI47").Offset(, m).Value
Nws.Range("M2:M44").Offset(, m).Value = _
ws1.Range("AL5:AL47").Offset(, m).Value

'copy part of sheet 2
Nws.Range("Z2:Z44").Offset(, m).Value = _
ws2.Range("AI5:AI47").Offset(, m).Value
Nws.Range("AB2:AB44").Offset(, m).Value = _
ws2.Range("AL5:AL47").Offset(, m).Value

'copy part of sheet 3
Nws.Range("K46:K88").Offset(, m).Value = _
ws3.Range("AI5:AI47").Offset(, m).Value
Nws.Range("M46:M88").Offset(, m).Value = _
ws3.Range("AL5:AL47").Offset(, m).Value

'copy part of sheet 4
Nws.Range("Z46:Z88").Offset(, m).Value = _
ws4.Range("AI5:AI47").Offset(, m).Value
Nws.Range("AB46:AB88").Offset(, m).Value = _
ws4.Range("AL5:AL47").Offset(, m).Value

m = m + 1
Next n

''''copy value back to sheets Credit History'''''
Nws.Range("A90:X132").Value = _
wsch.Range("D6:AA48").Value

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

MsgBox "completed part 2"

End Sub

This is the macro that runs them -

Sub Store_Data_Part1_and_2()

Run [Store_Data_to_ValueSheets_Part1()]

Run [Store_Data_to_ValueSheets_Part2()]

End Sub


Thanks for any help - Jim A
Click to expand...
 
J

Jim A

Sorry - I wanted to state both problems, but only included code for question
no. 2.

The code for the SaveAs problem 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 y1 As String, n1 As String
On Error Resume Next 'overcoming the error when a direcory already
exists for MkDir sPath

If Err.Number <> 0 Then MsgBox ("1 SaveAs Macro: " & Err.Description):
Err.clear

y1 = Sheets("1").Range("N1").Value
n1 = Sheets("1").Range("B1").Value

If Err.Number <> 0 Then MsgBox ("2 SaveAs Macro: " & Err.Description):
Err.clear

sPath = "D:\Ayers My Docs\AHS\AHS Credit Spreadsheets\" & n1 & " " & y1

If Err.Number <> 0 Then MsgBox ("3 SaveAs Macro: " & Err.Description):
Err.clear

'make Dir if NOT already there
MkDir sPath

If Err.Number <> 0 Then MsgBox ("4 SaveAs Macro: " & Err.Description):
Err.clear

''''''''''''''''''''''' SaveAs Code '''''''''''''''''''''''''''
ActiveWorkbook.SaveCopyAs sPath & "\" & y1 & Format(Now, " mmm-dd-yy
hhmmss") & ".xlsm"

If Err.Number <> 0 Then MsgBox ("5 SaveAs Macro: " & Err.Description):
Err.clear

MsgBox "Workbook Saved As '" & y1 & "' in folder '" & sPath & "'."

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

If Err.Number <> 0 Then MsgBox ("6 SaveAs Macro: " & Err.Description):
Err.clear
On Error GoTo 0

End Sub



THE MACRO IT IS CALLED OUT IN:



Sub Check_Store_SaveAs()

Run [CHECK_for_Sheets_THEN_Copy_DATA()]

Run [SaveAs()]

End Sub


THE OTHER MACRO THAT IS CALLED OUT IS:


Sub CHECK_for_Sheets_THEN_Copy_DATA()
'On Error Resume Next

'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()]

If Err.Number <> 0 Then MsgBox ("1 CHECK STORE COPY Macro: " &
Err.Description): Err.clear

Run [Copy_3QTR_Data_to_CreditHistory_NO_MSG()]
Run [Copy_4QTR_Data_to_CreditHistory_NO_MSG()]

If Err.Number <> 0 Then MsgBox ("2A CHECK STORE COPY Macro: " &
Err.Description): Err.clear


'n1 is students name
n1 = Sheets("1").Range("B1").Value

If Err.Number <> 0 Then MsgBox ("2B CHECK STORE COPY Macro: " &
Err.Description): Err.clear

'Check to see if worksheet exists
If WorksheetExists(n1) = True Then

If Err.Number <> 0 Then MsgBox ("2C CHECK STORE COPY Macro: " &
Err.Description): Err.clear

Run [Store_Data_to_ValueSheets_Part1()]

If Err.Number <> 0 Then MsgBox ("2D CHECK STORE COPY Macro: " &
Err.Description): Err.clear

Run [Store_Data_to_ValueSheets_Part2()]

If Err.Number <> 0 Then MsgBox ("3A CHECK STORE COPY Macro: " &
Err.Description): Err.clear

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

Else
'Add new sheet at end and name it
Worksheets("Value Template").Visible = True
ThisWorkbook.Worksheets("Value Template").Copy
after:=Worksheets(Worksheets.Count)

If Err.Number <> 0 Then MsgBox ("3B CHECK STORE COPY Macro: " &
Err.Description): Err.clear

ActiveSheet.Name = n1

If Err.Number <> 0 Then MsgBox ("3C CHECK STORE COPY Macro: " &
Err.Description): Err.clear

Worksheets("Value Template").Visible = False

If Err.Number <> 0 Then MsgBox ("4 CHECK STORE COPY Macro: " &
Err.Description): Err.clear

'Store Data
Run [Store_Data_to_ValueSheets_Part1()]

If Err.Number <> 0 Then MsgBox ("4A CHECK STORE COPY Macro: " &
Err.Description): Err.clear

Run [Store_Data_to_ValueSheets_Part2()]

If Err.Number <> 0 Then MsgBox ("5 CHECK STORE COPY Macro: " &
Err.Description): Err.clear

End If

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

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

'msg box
MsgBox "Data Stored to hidden worksheet."

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

If Err.Number <> 0 Then MsgBox ("6 CHECK STORE COPY Macro: " &
Err.Description): Err.clear
On Error GoTo 0

End Sub







Shane Devenshire said:
Hi,

You say the SaveAs macro works fine but executes twice. I don't see any
code for a saveas macro? In fact I don't see any command to execute a save?

--
If this helps, please click the Yes button

Cheers,
Shane Devenshire


Jim A said:
Hi - I have been working on some Macros. I am compiling a macro that runs
other macros. I have two noticeable problems.

1 - My SaveAs macro runs fine by itself. But when called or ran by another
macro, (which calls more than one macro) the SaveAs macro it stops.

2- Many of my macros, when ran by another macro (which runs more than one
macro) cycles through twice.

My specific question is about no. 2 and the following are the individual
macros and the macro that runs them.

Sub Store_Data_to_ValueSheets_Part1()
'''''This macro copies values from sheets 1, 2, 3, 4, and Credit
History''''''''
''''' NOT TO BE RUN INDEPENDENTLY - FOR THERE MUST EXIST A FOLDER
(n1)''''''''''''

MsgBox "inside StoreData Part1 macro"

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

'setting Dim
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
Dim wsch As Worksheet
Dim Nws As Worksheet
Dim n1 As String

'n1 is students name
n1 = Sheets("1").Range("B1").Value

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

'defining variable to worksheets
Set ws1 = ThisWorkbook.Sheets("1")
Set ws2 = ThisWorkbook.Sheets("2")
Set ws3 = ThisWorkbook.Sheets("3")
Set ws4 = ThisWorkbook.Sheets("4")
Set wsch = ThisWorkbook.Sheets("Credit History")
Set Nws = ThisWorkbook.Sheets(n1)

''''''''''''''''''''''''''Copy Code'''''''''''''''''''''''''''''''''''''
Dim i As Long, j As Long, k As Long
k = 0
j = 0
For i = 1 To 10

'copy values for sheets 1
Nws.Range("A2:A44").Offset(, j).Value = _
ws1.Range("E5:E47").Offset(, k).Value

'copy values for sheets 2
Nws.Range("P2:p44").Offset(, j).Value = _
ws2.Range("E5:E47").Offset(, k).Value

'copy values for sheets 3
Nws.Range("A46:A88").Offset(, j).Value = _
ws3.Range("E5:E47").Offset(, k).Value

'copy values for sheets 4
Nws.Range("P46:p88").Offset(, j).Value = _
ws4.Range("E5:E47").Offset(, k).Value

k = k + 3
j = j + 1

Next i


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

MsgBox "completed part1"

End Sub

THE OTHER -

Sub Store_Data_to_ValueSheets_Part2()
'''''This macro copies values from sheets 1, 2, 3, 4, and Credit
History'''''''
''''' NOT TO BE RUN INDEPENDENTLY - FOR THERE MUST EXIST A FOLDER
(n1)''''''''''''

MsgBox "inside StoreData Part2 macro"

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

'setting Dim
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
Dim wsch As Worksheet
Dim Nws As Worksheet
Dim n1 As String

'n1 is students name
n1 = Sheets("1").Range("B1").Value

'hide worksheet
Worksheets(n1).Visible = False

'defining variable to worksheets

Set ws1 = ThisWorkbook.Sheets("1")
Set ws2 = ThisWorkbook.Sheets("2")
Set ws3 = ThisWorkbook.Sheets("3")
Set ws4 = ThisWorkbook.Sheets("4")
Set wsch = ThisWorkbook.Sheets("Credit History")
Set Nws = ThisWorkbook.Sheets(n1)

'copy parts of sheets 1, 2, 3 and 4 that did not fit parameters above
Dim m As Long, n As Long
m = 0
For n = 1 To 2

'copy part of sheet 1
Nws.Range("K2:K44").Offset(, m).Value = _
ws1.Range("AI5:AI47").Offset(, m).Value
Nws.Range("M2:M44").Offset(, m).Value = _
ws1.Range("AL5:AL47").Offset(, m).Value

'copy part of sheet 2
Nws.Range("Z2:Z44").Offset(, m).Value = _
ws2.Range("AI5:AI47").Offset(, m).Value
Nws.Range("AB2:AB44").Offset(, m).Value = _
ws2.Range("AL5:AL47").Offset(, m).Value

'copy part of sheet 3
Nws.Range("K46:K88").Offset(, m).Value = _
ws3.Range("AI5:AI47").Offset(, m).Value
Nws.Range("M46:M88").Offset(, m).Value = _
ws3.Range("AL5:AL47").Offset(, m).Value

'copy part of sheet 4
Nws.Range("Z46:Z88").Offset(, m).Value = _
ws4.Range("AI5:AI47").Offset(, m).Value
Nws.Range("AB46:AB88").Offset(, m).Value = _
ws4.Range("AL5:AL47").Offset(, m).Value

m = m + 1
Next n

''''copy value back to sheets Credit History'''''
Nws.Range("A90:X132").Value = _
wsch.Range("D6:AA48").Value

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

MsgBox "completed part 2"

End Sub

This is the macro that runs them -

Sub Store_Data_Part1_and_2()

Run [Store_Data_to_ValueSheets_Part1()]

Run [Store_Data_to_ValueSheets_Part2()]

End Sub


Thanks for any help - Jim A
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

Copy a range data from 1 sheet to multiple selected sheets 1
Code condition 3
Copy code failing 2
Will Macro before a Function like Now() ?? 2
Copying a Pivot Chart (VBA) 0
Next Cell Empty Issues 3
Have two hard issues... I can't seem to resolve!!! 2
Quick Debug Help 3

Top