Excel VBA related query

Question

Excel VBA related query

Lakshmi Polisetti 0

Public Sub ResetAllTimerShapes()
    Dim ws As Worksheet
    Dim names As Variant, nm As Variant
    Dim labelText As String
    
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets("Checklist")
    If ws Is Nothing Then Exit Sub
    ' Category shapes you’re using
    names = Array("shpCoreProd", "shpProd", "shpNonProd", "shpBreak", "shpNoInv", "shpIdeal")
    ' Reset each category shape’s text and border
    For Each nm In names
        If Not ws.Shapes(CStr(nm)) Is Nothing Then
            labelText = shapeNameToLabel(CStr(nm)) & vbCrLf & "00:00:00"
            With ws.Shapes(CStr(nm)).TextFrame2
                .HorizontalAnchor = msoAnchorCenter
                .VerticalAnchor = msoAnchorMiddle
                With .TextRange
                    .Font.Bold = True
                    .ParagraphFormat.Alignment = msoAlignCenter
                    .Text = labelText
                End With
            End With
            ' neutral outline (no active highlight yet)
            With ws.Shapes(CStr(nm)).Line
                .Visible = msoTrue
                .ForeColor.RGB = RGB(0, 0, 0)
                .Weight = 0.75
            End With
        End If
    Next nm
    ' Reset CURRENT TASK display to 00:00:00 (no category)
    If Not ws.Shapes("shpCurrentTask") Is Nothing Then
        With ws.Shapes("shpCurrentTask").TextFrame2
            .HorizontalAnchor = msoAnchorCenter
            .VerticalAnchor = msoAnchorMiddle
            With .TextRange
                .Font.Bold = True
                .ParagraphFormat.Alignment = msoAlignCenter
                .Text = "CURRENT TASK" & vbCrLf & "• 00:00:00"
            End With
        End With
    End If
End Sub

Option Explicit
Private Sub Workbook_Open()
    Dim wsChecklist As Worksheet, wsSettings As Worksheet
    Dim s As String
    Dim resp As VbMsgBoxResult
    
    On Error Resume Next
    Set wsChecklist = ThisWorkbook.Worksheets("Checklist")
    Set wsSettings = ThisWorkbook.Worksheets("Settings")
    On Error GoTo 0
    
    ' ✅ Always open Checklist
    If Not wsChecklist Is Nothing Then wsChecklist.Activate
    
    ' ✅ Clear existing shift selection
    If Not wsSettings Is Nothing Then wsSettings.Range("B2").ClearContents
    ' ✅ Reset timer SHAPES to 00:00:00 (cells untouched)
    On Error Resume Next
    Application.Run "ResetAllTimerShapes"
    On Error GoTo 0
    ' === LOOP: Keep asking until valid shift is picked or user declines ===
    Do
        VBA.UserForms.Add("frmShiftPicker").Show vbModal
        If Len(Trim$(CStr(wsSettings.Range("B2").Value))) > 0 Then
            Exit Do
        Else
            resp = MsgBox("No shift selected. Would you like to pick one now?", vbYesNo + vbQuestion, "Shift Selection")
            If resp = vbNo Then
                ThisWorkbook.Close SaveChanges:=False
                Application.Quit
                Exit Sub
            End If
        End If
    Loop
    
    With wsSettings.Range("B2")
        If IsDate(.Value) Then .NumberFormatLocal = "h:mm AM/PM"
    End With
    
    s = wsSettings.Range("B2").Text
    If Len(s) > 0 Then
        MsgBox "Selected Shift: " & s, vbInformation, "Shift Confirmed"
    End If
    
    ' === Initialize your timers and mappings ===
    On Error Resume Next
    Application.Run "InitTimer"
    Application.Run "LoadQueueCategoryMap"
    Application.Run "StartTimer", "Ideal Time"
    On Error GoTo 0
End Sub

1 answer

Your answer

Answer 1

Hello Lakshmi Polisetti,

Welcome to Microsoft Q&A Forum.

From your description, I can understand that you are having a shift selection mechanism not working reliably, and because the code uses broad error suppression, so you don't see what is going wrong or where.

Here is a version of VBA code that you can kindly try

Put this in ThisWorkBook:

Option Explicit
Private Sub Workbook_Open()
   On Error GoTo ErrHandler
   Dim wsChecklist As Worksheet
   Dim wsSettings As Worksheet
   Dim s As String
   Dim needPick As Boolean
   Dim okPick As Boolean
   '--- Get references
   Set wsChecklist = GetSheet("Checklist")
   Set wsSettings = GetSheet("Settings")
   If wsChecklist Is Nothing Or wsSettings Is Nothing Then
       MsgBox "Missing 'Checklist' or 'Settings' sheet.", vbExclamation
       Exit Sub
   End If
   '--- Activate Checklist and clear previous value
   wsChecklist.Activate
   wsSettings.Range("B2").ClearContents
   '--- Ask user for shift if not filled
   needPick = (Trim$(CStr(wsSettings.Range("B2").Value)) = "")
   If needPick Then
       If MsgBox("No shift selected. Do you want to pick it now?", vbYesNo + vbQuestion, "Shift Selection") = vbYes Then
           okPick = EnsureShiftSelected(wsSettings)
           If Not okPick Then
               MsgBox "No shift selected. Please try again later.", vbExclamation
           End If
       End If
   End If
   '--- Format and confirm if valid
   If IsDate(wsSettings.Range("B2").Value) Then
       wsSettings.Range("B2").NumberFormatLocal = "h:mm AM/PM"
       s = Trim$(wsSettings.Range("B2").Text)
       If Len(s) > 0 Then
           MsgBox "Selected Shift: " & s, vbInformation, "Shift Confirmed"
       End If
   End If
   '--- Run timers safely
   RunSafe "InitTimer"
   RunSafe "LoadQueueCategoryMap"
   RunSafe "StartTimer", "Ideal Time"
   Exit Sub
'--- Error handler
ErrHandler:
   MsgBox "Error: " & Err.Description, vbCritical, "Workbook_Open"
End Sub

Add this in a regular module:

Option Explicit
'--- Helper: safely get sheet
Public Function GetSheet(name As String) As Worksheet
   On Error Resume Next
   Set GetSheet = ThisWorkbook.Worksheets(name)
   On Error GoTo 0
End Function
'--- Helper: safely run a macro
Public Sub RunSafe(ByVal procName As String, Optional ByVal arg As Variant)
   On Error Resume Next
   If IsMissing(arg) Then
       Application.Run procName
   Else
       Application.Run procName, arg
   End If
   If Err.Number <> 0 Then
       Debug.Print "RunSafe failed: " & procName & " - " & Err.Description
       Err.Clear
   End If
   On Error GoTo 0
End Sub
'--- Shift selection logic
Public Function EnsureShiftSelected(ByVal wsSettings As Worksheet) As Boolean
   On Error GoTo Fallback
   'Try running module method if exists
   Dim v As Variant
   v = Application.Run("modShiftPicker.EnsureShiftSelected")
   If VarType(v) = vbBoolean And v = True Then
       EnsureShiftSelected = (Trim$(CStr(wsSettings.Range("B2").Value)) <> "")
       Exit Function
   End If
Fallback:
   'Fallback: simple input box (works even if mod not present)
   Dim userShift As String
   userShift = InputBox("Enter your shift (e.g. Morning / Afternoon / Night):", "Shift Picker")
   If Len(Trim$(userShift)) > 0 Then
       wsSettings.Range("B2").Value = userShift
       EnsureShiftSelected = True
   Else
       EnsureShiftSelected = False
   End If
End Function

Please let me know if you need any further assistance.

Hope you have a great day.

If the answer is helpful, please click "Accept Answer" and kindly upvote it. If you have extra questions about this answer, please click "Comment".

Note: Please follow the steps in our documentation to enable e-mail notifications if you want to receive the related email notification for this thread.

Ian-T 3,835 Reputation points Microsoft External Staff Moderator

2025-10-15T10:03:17.5+00:00

Hello Lakshmi Polisetti,

I’m following up to check on the status of this issue.

Have you had an opportunity to review the replies shared earlier?

Any update you can provide would be greatly appreciated.

Share via

Excel VBA related query

1 answer

Your answer