CFMI
asked on
MS Excel VBA to complete after the final worksheet
Experts,
Attached is a spreadsheet (.xls) that applies a macro to a selected workbook (.xlsm) with 10 worksheets.
The following code appears to work; however, it never completes and there is a continuous circle. Along the way, it appears all of the worksheets are being updated.
How can the code be modified to stop after completion?
I think the problem might be in the sub procedure named, Sub WoksheetsByCodeName (at the end).
Private Sub cmdOK_Click()
cmdOK.Enabled = False
Dim app As Application
Dim wbTarget As Workbook ' *** REINSTATED!
Dim strReturnedValue As String
Dim SSFileName As String
Dim FullName As String
If Risk = -1 Then
'========================= ========== ========== ===
'Set a reference to the new instance
'========================= ========== ========== ===
Set app = New Application
With app
.Visible = True
.WindowState = xlMinimized
'========================= ========== ========== ===
'Open Workbook
'========================= ========== ========== ===
FullName = UserForm1.SSFileName
'Set wbTarget = app.Workbooks.Open(UserFor m1.SSFileN ame)
Set wbTarget = Workbooks.Open(UserForm1.S SFileName)
'========================= ========== ========== ===
'Run selected macro
'========================= ========== ========== ===
'Application.Run "SSreportBuilder.xls!McrRi sk"
WoksheetsByCodeName
'========================= ========== ========== ===
'Close Workbook and Kill the instance
'========================= ========== ========== ===
wbTarget.Close True
.Quit
End With
cmdOK.Enabled = False
MsgBox "The Spreadsheet has been updated using the correct formats"
Else
MsgBox "Please select a Macro"
End If
Unload Me
End Sub
Private Sub cmdSelect_Click()
Dim fileToOpen As Variant
fileToOpen = Application.GetOpenFilenam e("Excel files(*.xls*),*.xls*", , "Select File")
If fileToOpen <> False Then
SSFileName.Value = fileToOpen
End If
End Sub
Private Sub OptionButton1_Click()
End Sub
Public Sub SpreadsheetPath()
Dim FULL_PATH As String
End Sub
Private Sub DoAll()
Dim wbkX As Workbook
For Each wbkX In Application.Workbooks
wbkX.Activate
Application.Run ThisWorkbook.Name & "!McrRisk"
Next wbkX
End Sub
Sub WoksheetsByCodeName()
Dim ws As Worksheet
Dim lngRow As Long
Dim lngCount As Long
For Each ws In Worksheets
lngRow = 8
'Select case is case sensitive
Select Case UCase(ws.CodeName)
Case "SHEET10"
Case Else ' do calculations for all other sheets
With ws
Do
lngCount = .Range("A" & lngRow).End(xlDown).Row - lngRow
Application.Run "SSreportBuilder.xls!McrRi sk"
If lngRow > 100 Then Exit Do
Loop
End With
End Select
Next ws
End Sub
SSReportBuilder.xls
Attached is a spreadsheet (.xls) that applies a macro to a selected workbook (.xlsm) with 10 worksheets.
The following code appears to work; however, it never completes and there is a continuous circle. Along the way, it appears all of the worksheets are being updated.
How can the code be modified to stop after completion?
I think the problem might be in the sub procedure named, Sub WoksheetsByCodeName (at the end).
Private Sub cmdOK_Click()
cmdOK.Enabled = False
Dim app As Application
Dim wbTarget As Workbook ' *** REINSTATED!
Dim strReturnedValue As String
Dim SSFileName As String
Dim FullName As String
If Risk = -1 Then
'=========================
'Set a reference to the new instance
'=========================
Set app = New Application
With app
.Visible = True
.WindowState = xlMinimized
'=========================
'Open Workbook
'=========================
FullName = UserForm1.SSFileName
'Set wbTarget = app.Workbooks.Open(UserFor
Set wbTarget = Workbooks.Open(UserForm1.S
'=========================
'Run selected macro
'=========================
'Application.Run "SSreportBuilder.xls!McrRi
WoksheetsByCodeName
'=========================
'Close Workbook and Kill the instance
'=========================
wbTarget.Close True
.Quit
End With
cmdOK.Enabled = False
MsgBox "The Spreadsheet has been updated using the correct formats"
Else
MsgBox "Please select a Macro"
End If
Unload Me
End Sub
Private Sub cmdSelect_Click()
Dim fileToOpen As Variant
fileToOpen = Application.GetOpenFilenam
If fileToOpen <> False Then
SSFileName.Value = fileToOpen
End If
End Sub
Private Sub OptionButton1_Click()
End Sub
Public Sub SpreadsheetPath()
Dim FULL_PATH As String
End Sub
Private Sub DoAll()
Dim wbkX As Workbook
For Each wbkX In Application.Workbooks
wbkX.Activate
Application.Run ThisWorkbook.Name & "!McrRisk"
Next wbkX
End Sub
Sub WoksheetsByCodeName()
Dim ws As Worksheet
Dim lngRow As Long
Dim lngCount As Long
For Each ws In Worksheets
lngRow = 8
'Select case is case sensitive
Select Case UCase(ws.CodeName)
Case "SHEET10"
Case Else ' do calculations for all other sheets
With ws
Do
lngCount = .Range("A" & lngRow).End(xlDown).Row - lngRow
Application.Run "SSreportBuilder.xls!McrRi
If lngRow > 100 Then Exit Do
Loop
End With
End Select
Next ws
End Sub
SSReportBuilder.xls
Also after running this code a few time in began to fail on the line:
If fileToOpen <> False Then
Some thoughts....
Try adding message box to the loop to see what lngRow is...
Perhaps you should be 'moving' the cell reference up by one somewhere in your macro?
Or perhaps in your main code loop, you need to increment lngRow? (lngRow=lngRow+1)
Also consider simply inserting the raw data into an already formatted "template" file.
Lets see if an Excel Experts chimes in and can see what I missed...
JeffCoachman
If fileToOpen <> False Then
Some thoughts....
Try adding message box to the loop to see what lngRow is...
Perhaps you should be 'moving' the cell reference up by one somewhere in your macro?
Or perhaps in your main code loop, you need to increment lngRow? (lngRow=lngRow+1)
Also consider simply inserting the raw data into an already formatted "template" file.
Lets see if an Excel Experts chimes in and can see what I missed...
JeffCoachman
In sub WoksheetsByCodeName, you set lngRow to 8 at the beginning, but never increment it after that. It's no wonder that your test for lngRow>100 is never satisfied.
As Jeff Coachman pointed out, you need to put a statement incrementing lngRow in the Do loop. The problem is that I don't see any benefit to calling sub McrRisk more than once. So I wonder why the Do loop is there at all. I took it out in the snippet below.
As Jeff Coachman pointed out, you need to put a statement incrementing lngRow in the Do loop. The problem is that I don't see any benefit to calling sub McrRisk more than once. So I wonder why the Do loop is there at all. I took it out in the snippet below.
Sub WoksheetsByCodeName()
Dim ws As Worksheet
Dim lngRow As Long
Dim lngCount As Long
For Each ws In Worksheets
lngRow = 8
'Select case is case sensitive
Select Case UCase(ws.CodeName)
Case "SHEET10"
Case Else ' do calculations for all other sheets
With ws
'Do
lngCount = .Range("A" & lngRow).End(xlDown).Row - lngRow
Application.Run "SSreportBuilder.xls!McrRisk"
'If lngRow > 100 Then Exit Do
'Loop
End With
End Select
Next ws
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Experts,
Thank you for the suggestions you provided; however, only one worksheet has updates.
Please see the attached code and the final workbook (4 worksheets).
What can be modified so all of the worksheets update?
FYI...My accountants want their spreadsheet updated with the correct formats (manually I could instruct them to open both workbooks then on their workbok, right click to select all worksheets and run the Macro from the template) but my manager prefers a click button.
Thanks,
SSReportBuilder.xls
Test3.xlsm
Thank you for the suggestions you provided; however, only one worksheet has updates.
Please see the attached code and the final workbook (4 worksheets).
What can be modified so all of the worksheets update?
FYI...My accountants want their spreadsheet updated with the correct formats (manually I could instruct them to open both workbooks then on their workbok, right click to select all worksheets and run the Macro from the template) but my manager prefers a click button.
Thanks,
SSReportBuilder.xls
Test3.xlsm
Your sub McrRisk did its formatting on the active worksheet. Unless you activate each worksheet in turn, McrRisk is only ever going to work on one worksheet.
Rather than activate worksheets and select cells, it is better to pass the worksheet from the userform sub to McrRisk.
Rather than activate worksheets and select cells, it is better to pass the worksheet from the userform sub to McrRisk.
Sub WoksheetsByCodeName()
Dim ws As Worksheet
Dim lngRow As Long
Dim lngCount As Long
For Each ws In Worksheets
lngRow = 8
'Select case is case sensitive
Select Case UCase(ws.CodeName)
Case "SHEET10"
Case Else ' do calculations for all other sheets
With ws
'Do
lngCount = .Range("A" & lngRow).End(xlDown).Row - lngRow
McrRisk ws
'If lngRow > 100 Then Exit Do
'Loop
End With
End Select
Next ws
End Sub
Sub McrRisk(ws As Worksheet)
'
' McrRisk Macro
' Format entire worksheet
' Thousands
With ws
.Range( _
"D14:O14,D17:O17,D20:O20,D23:O23,D25:O25,D28:O28,D31:O31,D34:O34,D37:O37,D41:O41,D42:O42,D46:O49,D51:O51,D55:O57,D59:O59" _
).NumberFormat = "#,##0,;(#,##0,)"
' Decimals
.Range("D15:O15,D18:O18,D21:O21,D26:O26,D29:O29,D32:O32,D35:O35,D38:O38").NumberFormat = "#,##0.00;(#,##0.00)"
' Numbers
.Range("D62:O62,D64:O66,D68:O68").NumberFormat = "#,##0;(#,##0)"
' Percentage
.Range("D43:O44,D53:O53,D60:O60").NumberFormat = "0.00%;(0.00%)"
' Header Copy
.Range("N10").Copy .Range("O10")
' Header Update
.Range("O9").FormulaR1C1 = "Variance"
' Header Delete
.Range("C9:C12").ClearContents
' Include Color
With .Range("G14:I68").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
With .Range("M14:O68").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
End With
End Sub
ASKER
I only had to remark one statement, "Application.Goto .Range("C2")" and it worked very well. Thank You very much!
hi,
Should the points have gone to me or to Byundt?
Rob
Should the points have gone to me or to Byundt?
Rob
Rob,
I think the points went to the right place, as you posted that approach way before I did. You also had an Application.GoTo statement and I didn't.
With hindsight, I wish that you had posted your code changes in a snippet. "Is a candle brought to be put under a bushel? Let your light so shine before men, that they may see your good works."
In the Excel TA, we are trying to improve thread quality and Google page rank by posting formulas and code directly in the Comment rather than in a workbook with a blind link. If you post a workbook, it should augment your solution rather than be the solution. The workbook proves that the suggestion works and may clarify assumptions made in worksheet layout.
Brad
I think the points went to the right place, as you posted that approach way before I did. You also had an Application.GoTo statement and I didn't.
With hindsight, I wish that you had posted your code changes in a snippet. "Is a candle brought to be put under a bushel? Let your light so shine before men, that they may see your good works."
In the Excel TA, we are trying to improve thread quality and Google page rank by posting formulas and code directly in the Comment rather than in a workbook with a blind link. If you post a workbook, it should augment your solution rather than be the solution. The workbook proves that the suggestion works and may clarify assumptions made in worksheet layout.
Brad
hi Brad,
Thank you for the kind words. I'll try & let my light shine a little more but it's a challenge when I'm standing beside giants.
I like your logic for page ranking etc and will try & remember to use code snippets in the future. I had considered using a snippet this time, but I made changes to more of the code in the file than was mentioned in the question so I didn't want to dilute the thread with general coding suggestions.
CFMI, thanks for the points :-)
Rob
Thank you for the kind words. I'll try & let my light shine a little more but it's a challenge when I'm standing beside giants.
I like your logic for page ranking etc and will try & remember to use code snippets in the future. I had considered using a snippet this time, but I made changes to more of the code in the file than was mentioned in the question so I didn't want to dilute the thread with general coding suggestions.
CFMI, thanks for the points :-)
Rob
In any event, AFAICT, this line:
If lngRow > 100 Then Exit Do
Says to Exit the loop if "lngRow" is greater than 100
This means that if lngRow is 100 or less, the code keeps looping...
This is what happened to me when I just selected a random Excel file to process.
lngRow was always 17 for some reason...