Pick up in the middle of a macro

sdoppke

Well-known Member
Joined
Jun 10, 2010
Messages
647
Hi everyone title says it all, i cant seem to find how to exit one macro and pick up somewhere else (not the beginning of another macro). I bet its eazy, just cant figure it out. :(


Any ideas?

sd
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
You would have to tell your second macro that you want execution to start somewhere other than at the beginning.

Do you always want to start the second macro somewhere other than the beginning or do you sometimes want it to start executing at the beginning?

You can design your second macro like this:-
Code:
Public Sub MyMacro(ByVal argJump As String)

  If argJump="TOP" Then
    ' do one part of the macro
  End If
 
  If argJump="OTHER" Then
    ' do another part of the macro
  End If

End Sub
Then you can control where you want execution to start by calling it as Call MyMacro("TOP") or Call MyMacro("OTHER"), etc.

However be aware that when you Call another macro, when it finishes, control returns to the statement after the original Call statement.
 
Upvote 0
You would have to tell your second macro that you want execution to start somewhere other than at the beginning.

Do you always want to start the second macro somewhere other than the beginning or do you sometimes want it to start executing at the beginning?

You can design your second macro like this:-
Code:
Public Sub MyMacro(ByVal argJump As String)
 
  If argJump="TOP" Then
    ' do one part of the macro
  End If
 
  If argJump="OTHER" Then
    ' do another part of the macro
  End If
 
End Sub
Then you can control where you want execution to start by calling it as Call MyMacro("TOP") or Call MyMacro("OTHER"), etc.

However be aware that when you Call another macro, when it finishes, control returns to the statement after the original Call statement.

Ruddles, thank you very much for the response and help. That creates an error that says the argument cannot be optional?

To give a bit more information. The situation starts in a user form, when the user form is complete then MyMacro runs. what i was trying to prevent is if the user chooses cancel in the form, the MyMacro would not run any more (would pick up at the end "end sub").

Thanks again.

sd
 
Upvote 0
They way it's written, you have to supply an argument, even if it's an empty string.

But you're making it more complicated than it should be. The question is; what is it that calls MyMacro when the user form is complete? That's the place to decide what to do next. If the user clicks Cancel and you don't want to call MyMacro, don't call it - simple as that.

Perhaps this is the point at which you should post your code so that we can advise better. Please place it between CODE tags - the # icon in the advanced editor toolbar.
 
Last edited:
Upvote 0
They way it's written, you have to supply an argument, even if it's an empty string.

But you're making it more complicated than it should be. The question is; what is it that calls MyMacro when the user form is complete? That's the place to decide what to do next. If the user clicks Cancel and you don't want to call MyMacro, don't call it - simple as that.

Perhaps this is the point at which you should post your code so that we can advise better. Please place it between CODE tags - the # icon in the advanced editor toolbar.


This is userform script
Code:
Private Sub CommandButton1_Click()
    If Not (AllComboBoxesFilled()) Then
        MsgBox "Please complete the form, all boxes are required.", vbInformation, "Update Store Hours"
    Else
    Application.ScreenUpdating = False
    
        Dim ws As Worksheet, rngFind, rngRow As Range
     
    Set ws = ThisWorkbook.Sheets("StoreHours")
    StoreNumber = Worksheets("MyStoreInfo").Range("C2")
     
    Set rngFind = ws.Range("C:C").Find(what:=StoreNumber, MatchCase:=True)
     
    If Not rngFind Is Nothing Then
         
    rngFind.Offset(0, 3).Value = Me.SundayOpen.Value
    rngFind.Offset(0, 4).Value = Me.SundayClose.Value
    rngFind.Offset(0, 5).Value = Me.MondayOpen.Value
    rngFind.Offset(0, 6).Value = Me.MondayClose.Value
    rngFind.Offset(0, 7).Value = Me.TuesdayOpen.Value
    rngFind.Offset(0, 8).Value = Me.TuesdayClose.Value
    rngFind.Offset(0, 9).Value = Me.WednesdayOpen.Value
    rngFind.Offset(0, 10).Value = Me.WednesdayClose.Value
    rngFind.Offset(0, 11).Value = Me.ThursdayOpen.Value
    rngFind.Offset(0, 12).Value = Me.ThursdayClose.Value
    rngFind.Offset(0, 13).Value = Me.FridayOpen.Value
    rngFind.Offset(0, 14).Value = Me.FridayClose.Value
    rngFind.Offset(0, 15).Value = Me.SaturdayOpen.Value
    rngFind.Offset(0, 16).Value = Me.SaturdayClose.Value
    rngFind.Offset(0, 17).Value = Me.Month.Value
    rngFind.Offset(0, 18).Value = Me.Year.Value
    MsgBox "Store Hours have been updated)", vbInformation, "Update Store Hours"
    
    Application.ScreenUpdating = True
       
    Else
         MsgBox "Your Store Number is not input on the MY STORE INFO Tab", vbInformation, "Update Store Hours"

This is the cancel button script
Code:
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Unload Me
Application.ScreenUpdating = True
End Sub

And this is the Macro that calls the userform to open(sorry it;s big)
Code:
Public Sub GetCurrentSchedulingTemplate()
Dim wbThis As Workbook
Dim wbThat As Workbook
Dim ws As Worksheet
Dim x As Integer
Dim y As Integer
Dim Response As VbMsgBoxResult
Dim LR As Long, o As Long
StoreHours.Show 'update the store hours first :)
If SheetExists("Week 1") And SheetExists("Week 2") And SheetExists("Week 3") And SheetExists("Week 4") Then
Response = MsgBox("A scheduling template already exists, Press Yes to delete the old template and replace, or No to cancel and quit.", vbQuestion + _
vbYesNo)
If Response = vbYes Then
MsgBox "This can take up to a minute to talk with T-Mobile servers.", vbInformation, "WFM Tool"
Application.ScreenUpdating = False
With Sheets("WorksheetList")
    LR = .Range("A" & Rows.Count).End(xlUp).Row
    Application.DisplayAlerts = False
    On Error Resume Next
    For o = 1 To LR
        Sheets(.Range("A" & o).Value).Delete
    Next o
    On Error GoTo 0
    Application.DisplayAlerts = True
End With
Set wb = Workbooks.Open(Filename:="S:\WASeattle\WFM\Test\Retail Store Scheduling Template.xls")
Set i = ActiveWorkbook.Sheets
For Each sh In i
sh.Visible = True
Next
Windows("Retail Store Scheduling Template.xls").Activate
    Sheets(Array("Month at a Glance", "Daily Budget for the Month", "Week 1", _
        "Week 1 Chart", "Week 2", "Week 2 Chart", "Week 3", "Week 3 Chart", "Week 4", _
        "Week 4 Chart", "Week 5", "Week 5 Chart", "Productivity Calendars", _
        "Schedule at a Glance", "Peak Hours", "Productivity Calendar Mapping", _
        "Peak Hr Daily Allocation", "Store Productivity Mapping", "Store Names", _
        "Labor Budget")).Select
    Sheets("Month at a Glance").Activate
    Sheets(Array("Month at a Glance", "Daily Budget for the Month", "Week 1", _
        "Week 1 Chart", "Week 2", "Week 2 Chart", "Week 3", "Week 3 Chart", "Week 4", _
        "Week 4 Chart", "Week 5", "Week 5 Chart", "Productivity Calendars", _
        "Schedule at a Glance", "Peak Hours", "Productivity Calendar Mapping", _
        "Peak Hr Daily Allocation", "Store Productivity Mapping", "Store Names", _
        "Labor Budget")).Copy After:=ThisWorkbook. _
        Sheets(6)
For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Schedule Dashboard" And ws.Name <> "Week 1" And ws.Name <> "Week 2" And ws.Name <> "Week 3" And ws.Name <> "Week 4" And ws.Name <> "Week 5" Then ws.Visible = xlSheetHidden
Next
    Sheets("Schedule Tool").Visible = True
    Sheets("Schedule Tool").Select
        Range("A1").Select
    Sheets("Schedule Dashboard").Select
    Sheets("WorksheetList").Visible = True
    Sheets("WorksheetList").Select
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
    Sheets("WorksheetList").Select
Windows("Retail Store Scheduling Template.xls").Activate
With ThisWorkbook.Worksheets("WorksheetList")
.Range("A:A").ClearContents
For Each ws In ActiveWorkbook.Worksheets
y = y + 1
.Range("A" & y) = ws.Name
Next ws
End With
For Each WkbkName In Application.Workbooks()
        If WkbkName.Name <> ThisWorkbook.Name Then WkbkName.Close WkbkName.Saved = False
Next
Sheets("WorksheetList").Visible = False
Sheets("Schedule Dashboard").Select
        Range("D18").Select
Application.ScreenUpdating = True
MsgBox "Schedule template has been retrived. +1 for Doppke.", vbInformation, "Get Current Scheduling Template"
End If
Exit Sub
Else
MsgBox "This can take up to a minute to talk with T-Mobile servers.", vbInformation, "WFM Tool"
Application.ScreenUpdating = False
Set wb = Workbooks.Open(Filename:="S:\WASeattle\WFM\Test\Retail Store Scheduling Template.xls")
Set i = ActiveWorkbook.Sheets
For Each sh In i
sh.Visible = True
Next
Windows("Retail Store Scheduling Template.xls").Activate
    Sheets(Array("Month at a Glance", "Daily Budget for the Month", "Week 1", _
        "Week 1 Chart", "Week 2", "Week 2 Chart", "Week 3", "Week 3 Chart", "Week 4", _
        "Week 4 Chart", "Week 5", "Week 5 Chart", "Productivity Calendars", _
        "Schedule at a Glance", "Peak Hours", "Productivity Calendar Mapping", _
        "Peak Hr Daily Allocation", "Store Productivity Mapping", "Store Names", _
        "Labor Budget")).Select
    Sheets("Month at a Glance").Activate
    Sheets(Array("Month at a Glance", "Daily Budget for the Month", "Week 1", _
        "Week 1 Chart", "Week 2", "Week 2 Chart", "Week 3", "Week 3 Chart", "Week 4", _
        "Week 4 Chart", "Week 5", "Week 5 Chart", "Productivity Calendars", _
        "Schedule at a Glance", "Peak Hours", "Productivity Calendar Mapping", _
        "Peak Hr Daily Allocation", "Store Productivity Mapping", "Store Names", _
        "Labor Budget")).Copy After:=ThisWorkbook. _
        Sheets(6)
For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Schedule Dashboard" And ws.Name <> "Week 1" And ws.Name <> "Week 2" And ws.Name <> "Week 3" And ws.Name <> "Week 4" And ws.Name <> "Week 5" Then ws.Visible = xlSheetHidden
Next
    Sheets("Schedule Tool").Visible = True
    Sheets("Schedule Tool").Select
        Range("A1").Select
    Sheets("Schedule Dashboard").Select
    Sheets("WorksheetList").Visible = True
    Sheets("WorksheetList").Select
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
    Sheets("WorksheetList").Select
Windows("Retail Store Scheduling Template.xls").Activate
With ThisWorkbook.Worksheets("WorksheetList")
.Range("A:A").ClearContents
For Each ws In ActiveWorkbook.Worksheets
y = y + 1
.Range("A" & y) = ws.Name
Next ws
End With
For Each WkbkName In Application.Workbooks()
        If WkbkName.Name <> ThisWorkbook.Name Then WkbkName.Close WkbkName.Saved = False
Next
Sheets("WorksheetList").Visible = False
Sheets("Schedule Dashboard").Select
        Range("D18").Select
Application.ScreenUpdating = True
MsgBox "Schedule template has been retrived. +1 for Doppke.", vbInformation, "Get Current Scheduling Template"
End If
Exit Sub
End Sub


If the user presses the button GetCurrentSchedulilngTemplete the user form opens, if they press cancel it still continues with the rest of the GetCurrentSchedulilngTemplete script. I need to make sure it ends and does not alow the user to bypass the user form.

Thanks Ruddles for all the help. :)

sd
 
Upvote 0
CommandButton1_Click() seems to be incomplete.

Maybe the best way of handling this is to declare a global variable (Public FormValid As Boolean in a general code module) which you set to False when the useform loads. At the end of your userform processing, if you have all the fields you need, set FormValid to True.

When you get back to GetCurrentSchedulingTemplate(), test FormValid: if it's True, continue with the processing; if it's False (indicating that not all the fields were completed properly), skip the processing or Exit Sub, whichever's the most appropriate.
 
Upvote 0
CommandButton1_Click() seems to be incomplete.

Maybe the best way of handling this is to declare a global variable (Public FormValid As Boolean in a general code module) which you set to False when the useform loads. At the end of your userform processing, if you have all the fields you need, set FormValid to True.

When you get back to GetCurrentSchedulingTemplate(), test FormValid: if it's True, continue with the processing; if it's False (indicating that not all the fields were completed properly), skip the processing or Exit Sub, whichever's the most appropriate.

CommandButton1_Click (sorry i didnt select all to copy)
Code:
Private Sub CommandButton1_Click()
    If Not (AllComboBoxesFilled()) Then
        MsgBox "Please complete the form, all boxes are required.", vbInformation, "Update Store Hours"
    Else
    Application.ScreenUpdating = False
    
        Dim ws As Worksheet, rngFind, rngRow As Range
     
    Set ws = ThisWorkbook.Sheets("StoreHours")
    StoreNumber = Worksheets("MyStoreInfo").Range("C2")
     
    Set rngFind = ws.Range("C:C").Find(what:=StoreNumber, MatchCase:=True)
     
    If Not rngFind Is Nothing Then
         
    rngFind.Offset(0, 3).Value = Me.SundayOpen.Value
    rngFind.Offset(0, 4).Value = Me.SundayClose.Value
    rngFind.Offset(0, 5).Value = Me.MondayOpen.Value
    rngFind.Offset(0, 6).Value = Me.MondayClose.Value
    rngFind.Offset(0, 7).Value = Me.TuesdayOpen.Value
    rngFind.Offset(0, 8).Value = Me.TuesdayClose.Value
    rngFind.Offset(0, 9).Value = Me.WednesdayOpen.Value
    rngFind.Offset(0, 10).Value = Me.WednesdayClose.Value
    rngFind.Offset(0, 11).Value = Me.ThursdayOpen.Value
    rngFind.Offset(0, 12).Value = Me.ThursdayClose.Value
    rngFind.Offset(0, 13).Value = Me.FridayOpen.Value
    rngFind.Offset(0, 14).Value = Me.FridayClose.Value
    rngFind.Offset(0, 15).Value = Me.SaturdayOpen.Value
    rngFind.Offset(0, 16).Value = Me.SaturdayClose.Value
    rngFind.Offset(0, 17).Value = Me.Month.Value
    rngFind.Offset(0, 18).Value = Me.Year.Value
    MsgBox "Store Hours have been updated)", vbInformation, "Update Store Hours"
    
    Application.ScreenUpdating = True
       
    Else
         MsgBox "Your Store Number is not input on the MY STORE INFO Tab", vbInformation, "Update Store Hours"
       
    End If
    End If
End Sub

I looked at this for a while and am scratching my head :) Im afraid I dont understand all that you advised. Could you give me just a little more detail?

sd
 
Upvote 0
Okay, I've had a good look at your code.

You start GetCurrentSchedulingTemplate() (somehow) and that loads a userform called StoreHours. On that form is a command button called CommandButton1. The user fills in some fields on the userform and then clicks the command button, and the code behind the button (CommandButton1_Click())does some checking amd maybe displays a message box.

When control drops out of CommandButton1_Click(), VBA resumes where it left off, at the command following StoreHours.Show, whatever that is. I think you need to ensure that your userform is correctly filled in before you get to that point, in other words before you unload the userform.

I think your best bet would be to hold the user in the userform until he either fills it all in correctly or cancels out. If he fills it all in correctly and clicks OK, you set the FormValid flag to True; if he clicks Cancel, you set it to False. Then when you get to the command following StoreHours.Show, you just test FormValid and decide what you want to do.

Try this in a copy of your workbook: create a new general code module and place this line in it:-
Code:
[B]Public FormValid As Boolean[/B]

This is your new CommandButton1_Click():-
Code:
Private Sub CommandButton1_Click()
 
  Dim ws As Worksheet, rngFind [COLOR=red][B]As Range[/B][/COLOR], rngRow As Range
  
  [COLOR=red][B]FormValid = False
  
  Do Until FormValid
[/B][/COLOR]    If Not AllComboBoxesFilled() Then
      MsgBox "Please complete the form, all boxes are required.", vbExclamation, "Update Store Hours"
    Else
      Application.ScreenUpdating = False
      Set ws = ThisWorkbook.Sheets("StoreHours")
      StoreNumber = Worksheets("MyStoreInfo").Range("C2")
      Set rngFind = ws.Range("C:C").Find(what:=StoreNumber, MatchCase:=True)
      If Not rngFind Is Nothing Then
        rngFind.Offset(0, 3).Value = Me.SundayOpen.Value
        rngFind.Offset(0, 4).Value = Me.SundayClose.Value
        rngFind.Offset(0, 5).Value = Me.MondayOpen.Value
        rngFind.Offset(0, 6).Value = Me.MondayClose.Value
        rngFind.Offset(0, 7).Value = Me.TuesdayOpen.Value
        rngFind.Offset(0, 8).Value = Me.TuesdayClose.Value
        rngFind.Offset(0, 9).Value = Me.WednesdayOpen.Value
        rngFind.Offset(0, 10).Value = Me.WednesdayClose.Value
        rngFind.Offset(0, 11).Value = Me.ThursdayOpen.Value
        rngFind.Offset(0, 12).Value = Me.ThursdayClose.Value
        rngFind.Offset(0, 13).Value = Me.FridayOpen.Value
        rngFind.Offset(0, 14).Value = Me.FridayClose.Value
        rngFind.Offset(0, 15).Value = Me.SaturdayOpen.Value
        rngFind.Offset(0, 16).Value = Me.SaturdayClose.Value
        rngFind.Offset(0, 17).Value = Me.Month.Value
        rngFind.Offset(0, 18).Value = Me.Year.Value
        MsgBox "Store Hours have been updated", vbInformation, "Update Store Hours"
        Application.ScreenUpdating = True
[COLOR=red][B]        FormValid = True[/B][/COLOR]
[COLOR=red][B]        Unload Me
        Exit Sub
[/B][/COLOR]      Else
         MsgBox "Your Store Number is not input on the MY STORE INFO Tab", vbInformation, "Update Store Hours"
      End If
    End If
[COLOR=red][B]  Loop
[/B][/COLOR]  
End Sub
So there are only two ways out of the form: hitting Cancel or filling in all the fields correctly ad clicking the OK button.

Then you just need to decide what you're going to do when you get back to GetCurrentSchedulingTemplate() - what you're going to do if FormValid is True and what if it's False. That bit of the macro will look like this:-
Code:
Public Sub GetCurrentSchedulingTemplate()

Dim wbThis As Workbook
Dim wbThat As Workbook
Dim ws As Worksheet
Dim x As Integer
Dim y As Integer
Dim Response As VbMsgBoxResult
Dim LR As Long, o As Long

StoreHours.Show 'update the store hours first :)
 
If FormValid Then
   ' do something... the rest of GetCurrentSchedulingTemplate()?
Else
   ' do something if userform not correctly filled in...
End If

If you just want to end the macro if the userform isn't correctly filled in, it might be as simple as this;-
Code:
Public Sub GetCurrentSchedulingTemplate()
 
  Dim wbThis As Workbook
  Dim wbThat As Workbook
  Dim ws As Worksheet
  Dim x As Integer
  Dim y As Integer
  Dim Response As VbMsgBoxResult
  Dim LR As Long, o As Long
  
  StoreHours.Show 'update the store hours first :)
  
[B][COLOR=red]  If Not FormValid Then Exit Sub
[/COLOR][/B]  
  If SheetExists("Week 1") And SheetExists("Week 2") And SheetExists("Week 3") And SheetExists("Week 4") Then
    Response = MsgBox("A scheduling template already exists, Press Yes to delete the old template and replace, or No to cancel and quit.", _
               vbQuestion + vbYesNo)
    If Response = vbYes Then
      MsgBox "This can take up to a minute to talk with T-Mobile servers.", vbInformation, "WFM Tool"
      Application.ScreenUpdating = False
      With Sheets("WorksheetList")
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        Application.DisplayAlerts = False
        On Error Resume Next
        For o = 1 To LR
          Sheets(.Range("A" & o).Value).Delete
        Next o
        On Error GoTo 0
        Application.DisplayAlerts = True
      End With
      Set wb = Workbooks.Open(Filename:="S:\WASeattle\WFM\Test\Retail Store Scheduling Template.xls")
      Set i = ActiveWorkbook.Sheets
      For Each sh In i
        sh.Visible = True
      Next
      Windows("Retail Store Scheduling Template.xls").Activate
      Sheets(Array("Month at a Glance", "Daily Budget for the Month", "Week 1", _
          "Week 1 Chart", "Week 2", "Week 2 Chart", "Week 3", "Week 3 Chart", "Week 4", _
          "Week 4 Chart", "Week 5", "Week 5 Chart", "Productivity Calendars", _
          "Schedule at a Glance", "Peak Hours", "Productivity Calendar Mapping", _
          "Peak Hr Daily Allocation", "Store Productivity Mapping", "Store Names", _
          "Labor Budget")).Select
      Sheets("Month at a Glance").Activate
      Sheets(Array("Month at a Glance", "Daily Budget for the Month", "Week 1", _
          "Week 1 Chart", "Week 2", "Week 2 Chart", "Week 3", "Week 3 Chart", "Week 4", _
          "Week 4 Chart", "Week 5", "Week 5 Chart", "Productivity Calendars", _
          "Schedule at a Glance", "Peak Hours", "Productivity Calendar Mapping", _
          "Peak Hr Daily Allocation", "Store Productivity Mapping", "Store Names", _
          "Labor Budget")).Copy After:=ThisWorkbook. _
          Sheets(6)
      For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Schedule Dashboard" And ws.Name <> "Week 1" And ws.Name <> "Week 2" And ws.Name <> "Week 3" And ws.Name <> "Week 4" And ws.Name <> "Week 5" Then ws.Visible = xlSheetHidden
      Next
      Sheets("Schedule Tool").Visible = True
      Sheets("Schedule Tool").Select
      Range("A1").Select
      Sheets("Schedule Dashboard").Select
      Sheets("WorksheetList").Visible = True
      Sheets("WorksheetList").Select
      Cells.Select
      Selection.ClearContents
      Range("A1").Select
      Sheets("WorksheetList").Select
      Windows("Retail Store Scheduling Template.xls").Activate
      With ThisWorkbook.Worksheets("WorksheetList")
        .Range("A:A").ClearContents
        For Each ws In ActiveWorkbook.Worksheets
          y = y + 1
          .Range("A" & y) = ws.Name
        Next ws
      End With
      For Each WkbkName In Application.Workbooks()
        If WkbkName.Name <> ThisWorkbook.Name Then WkbkName.Close WkbkName.Saved = False
      Next
      Sheets("WorksheetList").Visible = False
      Sheets("Schedule Dashboard").Select
      Range("D18").Select
      Application.ScreenUpdating = True
      MsgBox "Schedule template has been retrived. +1 for Doppke.", vbInformation, "Get Current Scheduling Template"
    End If
    Exit Sub
  Else
    MsgBox "This can take up to a minute to talk with T-Mobile servers.", vbInformation, "WFM Tool"
    Application.ScreenUpdating = False
    Set wb = Workbooks.Open(Filename:="S:\WASeattle\WFM\Test\Retail Store Scheduling Template.xls")
    Set i = ActiveWorkbook.Sheets
    For Each sh In i
    sh.Visible = True
    Next
    Windows("Retail Store Scheduling Template.xls").Activate
    Sheets(Array("Month at a Glance", "Daily Budget for the Month", "Week 1", _
        "Week 1 Chart", "Week 2", "Week 2 Chart", "Week 3", "Week 3 Chart", "Week 4", _
        "Week 4 Chart", "Week 5", "Week 5 Chart", "Productivity Calendars", _
        "Schedule at a Glance", "Peak Hours", "Productivity Calendar Mapping", _
        "Peak Hr Daily Allocation", "Store Productivity Mapping", "Store Names", _
        "Labor Budget")).Select
    Sheets("Month at a Glance").Activate
    Sheets(Array("Month at a Glance", "Daily Budget for the Month", "Week 1", _
        "Week 1 Chart", "Week 2", "Week 2 Chart", "Week 3", "Week 3 Chart", "Week 4", _
        "Week 4 Chart", "Week 5", "Week 5 Chart", "Productivity Calendars", _
        "Schedule at a Glance", "Peak Hours", "Productivity Calendar Mapping", _
        "Peak Hr Daily Allocation", "Store Productivity Mapping", "Store Names", _
        "Labor Budget")).Copy After:=ThisWorkbook.Sheets(6)
    For Each ws In ThisWorkbook.Worksheets
      If ws.Name <> "Schedule Dashboard" And ws.Name <> "Week 1" And ws.Name <> "Week 2" And ws.Name <> "Week 3" And ws.Name <> "Week 4" And ws.Name <> "Week 5" Then ws.Visible = xlSheetHidden
    Next
    Sheets("Schedule Tool").Visible = True
    Sheets("Schedule Tool").Select
        Range("A1").Select
    Sheets("Schedule Dashboard").Select
    Sheets("WorksheetList").Visible = True
    Sheets("WorksheetList").Select
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
    Sheets("WorksheetList").Select
    Windows("Retail Store Scheduling Template.xls").Activate
    With ThisWorkbook.Worksheets("WorksheetList")
      .Range("A:A").ClearContents
      For Each ws In ActiveWorkbook.Worksheets
        y = y + 1
        .Range("A" & y) = ws.Name
      Next ws
    End With
    For Each WkbkName In Application.Workbooks()
      If WkbkName.Name <> ThisWorkbook.Name Then WkbkName.Close WkbkName.Saved = False
    Next
    Sheets("WorksheetList").Visible = False
    Sheets("Schedule Dashboard").Select
    Range("D18").Select
    Application.ScreenUpdating = True
    MsgBox "Schedule template has been retrived. +1 for Doppke.", vbInformation, "Get Current Scheduling Template"
  End If
 
End Sub
 
Upvote 0
Ruddles once again, thank you for your consistent help with this. I opted for the first, but i keep getting this loop of the msg box that says "Please complete the form, all boxes are required." and it wont go away or allow to completion. It just keeps popping up? I messed it up somewhere...

Here is the code i chose:

Code:
[B]Public FormValid As Boolean[/B]

Code:
Private Sub CommandButton1_Click()
 
  Dim ws As Worksheet, rngFind [COLOR=red][B]As Range[/B][/COLOR], rngRow As Range
 
  [COLOR=red][B]FormValid = False[/B][/COLOR]
 
[B][COLOR=red] Do Until FormValid[/COLOR][/B]
    If Not AllComboBoxesFilled() Then
      MsgBox "Please complete the form, all boxes are required.", vbExclamation, "Update Store Hours"
    Else
      Application.ScreenUpdating = False
      Set ws = ThisWorkbook.Sheets("StoreHours")
      StoreNumber = Worksheets("MyStoreInfo").Range("C2")
      Set rngFind = ws.Range("C:C").Find(what:=StoreNumber, MatchCase:=True)
      If Not rngFind Is Nothing Then
        rngFind.Offset(0, 3).Value = Me.SundayOpen.Value
        rngFind.Offset(0, 4).Value = Me.SundayClose.Value
        rngFind.Offset(0, 5).Value = Me.MondayOpen.Value
        rngFind.Offset(0, 6).Value = Me.MondayClose.Value
        rngFind.Offset(0, 7).Value = Me.TuesdayOpen.Value
        rngFind.Offset(0, 8).Value = Me.TuesdayClose.Value
        rngFind.Offset(0, 9).Value = Me.WednesdayOpen.Value
        rngFind.Offset(0, 10).Value = Me.WednesdayClose.Value
        rngFind.Offset(0, 11).Value = Me.ThursdayOpen.Value
        rngFind.Offset(0, 12).Value = Me.ThursdayClose.Value
        rngFind.Offset(0, 13).Value = Me.FridayOpen.Value
        rngFind.Offset(0, 14).Value = Me.FridayClose.Value
        rngFind.Offset(0, 15).Value = Me.SaturdayOpen.Value
        rngFind.Offset(0, 16).Value = Me.SaturdayClose.Value
        rngFind.Offset(0, 17).Value = Me.Month.Value
        rngFind.Offset(0, 18).Value = Me.Year.Value
        MsgBox "Store Hours have been updated", vbInformation, "Update Store Hours"
        Application.ScreenUpdating = True
[COLOR=red][B]       FormValid = True[/B][/COLOR]
[COLOR=red][B]       Unload Me[/B][/COLOR]
[B][COLOR=red]       Exit Sub[/COLOR][/B]
      Else
         MsgBox "Your Store Number is not input on the MY STORE INFO Tab", vbInformation, "Update Store Hours"
      End If
    End If
[COLOR=red][B] Loop[/B][/COLOR]
  
End Sub

Code:
Public Sub GetCurrentSchedulingTemplate()
 
Dim wbThis As Workbook
Dim wbThat As Workbook
Dim ws As Worksheet
Dim x As Integer
Dim y As Integer
Dim Response As VbMsgBoxResult
Dim LR As Long, o As Long
 
StoreHours.Show 'update the store hours first :)
 
If FormValid Then
   ' do something... the rest of GetCurrentSchedulingTemplate()?
Else
   ' do something if userform not correctly filled in...
End If

Here is the actual code box 2:
Code:
Public Sub GetCurrentSchedulingTemplate()
Dim wbThis As Workbook
Dim wbThat As Workbook
Dim ws As Worksheet
Dim x As Integer
Dim y As Integer
Dim Response As VbMsgBoxResult
Dim LR As Long, o As Long
StoreHours.Show 'update the store hours first :)
 
If FormValid Then
   ' do something... the rest of GetCurrentSchedulingTemplate()?
  If SheetExists("Week 1") And SheetExists("Week 2") And SheetExists("Week 3") And SheetExists("Week 4") Then
    Response = MsgBox("A scheduling template already exists, Press Yes to delete the old template and replace, or No to cancel and quit.", _
               vbQuestion + vbYesNo)
    If Response = vbYes Then
      MsgBox "This can take up to a minute to talk with T-Mobile servers.", vbInformation, "WFM Tool"
      Application.ScreenUpdating = False
      With Sheets("WorksheetList")
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        Application.DisplayAlerts = False
        On Error Resume Next
        For o = 1 To LR
          Sheets(.Range("A" & o).Value).Delete
        Next o
        On Error GoTo 0
        Application.DisplayAlerts = True
      End With
      Set wb = Workbooks.Open(Filename:="S:\WASeattle\WFM\Test\Retail Store Scheduling Template.xls")
      Set i = ActiveWorkbook.Sheets
      For Each sh In i
        sh.Visible = True
      Next
      Windows("Retail Store Scheduling Template.xls").Activate
      Sheets(Array("Month at a Glance", "Daily Budget for the Month", "Week 1", _
          "Week 1 Chart", "Week 2", "Week 2 Chart", "Week 3", "Week 3 Chart", "Week 4", _
          "Week 4 Chart", "Week 5", "Week 5 Chart", "Productivity Calendars", _
          "Schedule at a Glance", "Peak Hours", "Productivity Calendar Mapping", _
          "Peak Hr Daily Allocation", "Store Productivity Mapping", "Store Names", _
          "Labor Budget")).Select
      Sheets("Month at a Glance").Activate
      Sheets(Array("Month at a Glance", "Daily Budget for the Month", "Week 1", _
          "Week 1 Chart", "Week 2", "Week 2 Chart", "Week 3", "Week 3 Chart", "Week 4", _
          "Week 4 Chart", "Week 5", "Week 5 Chart", "Productivity Calendars", _
          "Schedule at a Glance", "Peak Hours", "Productivity Calendar Mapping", _
          "Peak Hr Daily Allocation", "Store Productivity Mapping", "Store Names", _
          "Labor Budget")).Copy After:=ThisWorkbook. _
          Sheets(6)
      For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Schedule Dashboard" And ws.Name <> "Week 1" And ws.Name <> "Week 2" And ws.Name <> "Week 3" And ws.Name <> "Week 4" And ws.Name <> "Week 5" Then ws.Visible = xlSheetHidden
      Next
      Sheets("Schedule Tool").Visible = True
      Sheets("Schedule Tool").Select
      Range("A1").Select
      Sheets("Schedule Dashboard").Select
      Sheets("WorksheetList").Visible = True
      Sheets("WorksheetList").Select
      Cells.Select
      Selection.ClearContents
      Range("A1").Select
      Sheets("WorksheetList").Select
      Windows("Retail Store Scheduling Template.xls").Activate
      With ThisWorkbook.Worksheets("WorksheetList")
        .Range("A:A").ClearContents
        For Each ws In ActiveWorkbook.Worksheets
          y = y + 1
          .Range("A" & y) = ws.Name
        Next ws
      End With
      For Each WkbkName In Application.Workbooks()
        If WkbkName.Name <> ThisWorkbook.Name Then WkbkName.Close WkbkName.Saved = False
      Next
      Sheets("WorksheetList").Visible = False
      Sheets("Schedule Dashboard").Select
      Range("D18").Select
      Application.ScreenUpdating = True
      MsgBox "Schedule template has been retrived. +1 for Doppke.", vbInformation, "Get Current Scheduling Template"
    End If
    Exit Sub
  Else
    MsgBox "This can take up to a minute to talk with T-Mobile servers.", vbInformation, "WFM Tool"
    Application.ScreenUpdating = False
    Set wb = Workbooks.Open(Filename:="S:\WASeattle\WFM\Test\Retail Store Scheduling Template.xls")
    Set i = ActiveWorkbook.Sheets
    For Each sh In i
    sh.Visible = True
    Next
    Windows("Retail Store Scheduling Template.xls").Activate
    Sheets(Array("Month at a Glance", "Daily Budget for the Month", "Week 1", _
        "Week 1 Chart", "Week 2", "Week 2 Chart", "Week 3", "Week 3 Chart", "Week 4", _
        "Week 4 Chart", "Week 5", "Week 5 Chart", "Productivity Calendars", _
        "Schedule at a Glance", "Peak Hours", "Productivity Calendar Mapping", _
        "Peak Hr Daily Allocation", "Store Productivity Mapping", "Store Names", _
        "Labor Budget")).Select
    Sheets("Month at a Glance").Activate
    Sheets(Array("Month at a Glance", "Daily Budget for the Month", "Week 1", _
        "Week 1 Chart", "Week 2", "Week 2 Chart", "Week 3", "Week 3 Chart", "Week 4", _
        "Week 4 Chart", "Week 5", "Week 5 Chart", "Productivity Calendars", _
        "Schedule at a Glance", "Peak Hours", "Productivity Calendar Mapping", _
        "Peak Hr Daily Allocation", "Store Productivity Mapping", "Store Names", _
        "Labor Budget")).Copy After:=ThisWorkbook.Sheets(6)
    For Each ws In ThisWorkbook.Worksheets
      If ws.Name <> "Schedule Dashboard" And ws.Name <> "Week 1" And ws.Name <> "Week 2" And ws.Name <> "Week 3" And ws.Name <> "Week 4" And ws.Name <> "Week 5" Then ws.Visible = xlSheetHidden
    Next
    Sheets("Schedule Tool").Visible = True
    Sheets("Schedule Tool").Select
        Range("A1").Select
    Sheets("Schedule Dashboard").Select
    Sheets("WorksheetList").Visible = True
    Sheets("WorksheetList").Select
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
    Sheets("WorksheetList").Select
    Windows("Retail Store Scheduling Template.xls").Activate
    With ThisWorkbook.Worksheets("WorksheetList")
      .Range("A:A").ClearContents
      For Each ws In ActiveWorkbook.Worksheets
        y = y + 1
        .Range("A" & y) = ws.Name
      Next ws
    End With
    For Each WkbkName In Application.Workbooks()
      If WkbkName.Name <> ThisWorkbook.Name Then WkbkName.Close WkbkName.Saved = False
    Next
    Sheets("WorksheetList").Visible = False
    Sheets("Schedule Dashboard").Select
    Range("D18").Select
    Application.ScreenUpdating = True
    MsgBox "Schedule template has been retrived. +1 for Doppke.", vbInformation, "Get Current Scheduling Template"
  End If
  
  Else
   ' do something if userform not correctly filled in...
   MsgBox "This form needs to be filled out completely before submitting", vbInformation, "Update Store Hours"
End If
  
 
End Sub

Can you tell where i went wrong to keep getting this loop?

sd
 
Upvote 0
Ruddles i never posted my function, and after stepping through it, im wondering if that needs to looked at?

Code:
Function AllComboBoxesFilled() As Boolean
    Dim oneCB As Object
    AllComboBoxesFilled = True
    For Each oneCB In Me.Controls
        If TypeName(oneCB) = "ComboBox" Then
            AllComboBoxesFilled = AllComboBoxesFilled And (oneCB.Text <> vbNullString)
        End If
    Next oneCB
End Function

sd
 
Upvote 0

Forum statistics

Threads
1,224,566
Messages
6,179,558
Members
452,928
Latest member
101blockchains

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top