Select Case Code Not Working

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
3,671
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
My Select - Case code isn't performing the way I had expected. Would someone be kind enough to have a look and share with me where I have likely gone wrong.

If we assume the value for trc = "BP_ST_A" ...

Rich (BB code):
           Select Case trc
                Case Left(trc, 4) = "WPRK"
                    ws_target.Tab.Color = RGB(169, 208, 142)
                Case Left(trc, 5) = "SE_CU"
                    ws_target.Tab.Color = RGB(244, 176, 132)
                Case Left(trc, 5) = "SE_ST"
                    ws_target.Tab.Color = RGB(198, 89, 17)
                Case trc = "SP_CU_1"
                    ws_target.Tab.Color = RGB(172, 185, 202)
                Case trc = "SP_CU_2"
                    ws_target.Tab.Color = RGB(172, 185, 202)
                Case trc = "SP_CU_7"
                    ws_target.Tab.Color = RGB(172, 185, 202)
                Case trc = "SP_CU_A"
                    ws_target.Tab.Color = RGB(132, 151, 176)
                Case trc = "SP_CU_B"
                    ws_target.Tab.Color = RGB(132, 151, 176)
                Case trc = "SP_CU_C"
                    ws_target.Tab.Color = RGB(132, 151, 176)
                Case Left(trc, 5) = "WBLVD"
                    ws_target.Tab.Color = RGB(84, 130, 53)
                Case Left(trc, 5) = "WP_ST"
                    ws_target.Tab.Color = RGB(47, 117, 181)
                Case Left(trc, 5) = "HP_ST"
                    ws_target.Tab.Color = RGB(60, 135, 204)
                Case Left(trc, 5) = "BP_ST"
                    ws_target.Tab.Color = RGB(155, 194, 230)
                Case Left(trc, 5) = "RP_ST"
                    ws_target.Tab.Color = RGB(180, 198, 231)
                Case Left(trc, 3) = "FLD"
                    ws_target.Tab.Color = RGB(157, 117, 245)
                Case Left(trc, 3) = "ZOO"
                    ws_target.Tab.Color = RGB(255, 217, 88)
                Case Else
                    ws_target.Tab.Color = RGB(255, 230, 153)
            End Select
Something is not right with this code as the the Case line for left(trc,5) isn't being recognized to trigger the code. In this case left(trc,5) = "BP_ST" which should be caught in the line highlighted in blue.

None of the Case statements catch anything ... the loop (not shown) changing the values of trc always returns the "Case Else" criteria so all tabs regardless of the value of trc have a backcolor of RGB(255, 230, 153).
 

Some videos you may like

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).

silentwolf

Well-known Member
Joined
May 14, 2008
Messages
1,123
Office Version
  1. 2016
Hi,
well we should see the hole code.
What is trc?
What varible has been used for it.
It would be better if you provide the code so someone can test it rather then build the code may have it.
Is this code within a function or a sub?
 

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
3,671
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
trc is a simple string variable referring to a value in a cell of another workbook.


Code:
Sub start()

    Dim r, rr, cnt_shift, cnt_alias, cfnd, i, cnt_wkst As Integer
    Dim trc, bb As String
    Dim myVariable
    Dim tdate As Date
    Dim ref_date, rng_cfnd As Range
    Dim ref_date_row As Integer
    Dim bc
    Dim ui1
    
    Application.ScreenUpdating = False
    
    'open staff_schedule workbook
    
    If IsFileOpen("U:\PWS\Parks\Parks Operations\Sports\WATSOP19\STAFF\staff_schedule.xlsx") Then
        MsgBox "File already in use!"
    Else
        Workbooks.Open "U:\PWS\Parks\Parks Operations\Sports\WATSOP19\STAFF\staff_schedule.xlsx"
    End If
    Set wb_sschedule = Workbooks("staff_schedule.xlsx")
    wb_sschedule.Windows(1).Visible = False

    Set wb_pstaff = Workbooks("POST_STAFF.xlsm")
    
    Set ws_front = wb_pstaff.Worksheets("FRONT")
    Set ws_mastercu = wb_pstaff.Worksheets("MASTER_CU")
    Set ws_masterst = wb_pstaff.Worksheets("MASTER_ST")
    
    Set ws_schedule = wb_sschedule.Worksheets("STAFF_SCHEDULE")
    
    'step through all employees
    
    
    'a wise idea
    cnt_wkst = wb_pstaff.Worksheets.Count
    If cnt_wkst > 3 Then
        ui1 = MsgBox("This will create timesheets for all staff in this roster." & Chr(13) & "Any existing timesheets will be deleted." & Chr(13) & _
            "Do you wish to continue?", vbCritical + vbYesNo, "DANGER : CRITICAL DATA LOSS")
        If ui1 = vbNo Then
            Exit Sub
        Else
            ui1 = InputBox(":", "PASSWORD", "p***e")
            If ui1 = "purge" Then
                'TIMESHEETS.Show
                For i = cnt_wkst To 1 Step -1
                    If Worksheets(i).Name = "FRONT" Or Worksheets(i).Name = "MASTER_CU" Or Worksheets(i).Name = "MASTER_ST" Then
                        'TIMESHEETS.Show
                        '    With TIMESHEETS.Label1
                        '        .Caption = "Pass: " & Worksheets(i).Name
                        '        .ForeColor = RGB(0, 100, 0)
                         '   End With
                        'MsgBox "Pass: " & Worksheets(i).Name
                    Else
                        'TIMESHEETS.Show
                        'With TIMESHEETS.Label1
                        '    .Caption = "Delete: " & Worksheets(i).Name
                        '    .ForeColor = RGB(255, 100, 0)
                        'End With
                        'MsgBox "Delete: " & Worksheets(i).Name
                        Application.DisplayAlerts = False
                        Worksheets(i).Delete
                        Application.DisplayAlerts = True
                    End If
                Next i
            Else
                Exit Sub
            End If
        End If
    End If
        
    With ws_front
        .Unprotect
        .Range("M5:M50").Clear
    End With
    
    For r = 5 To 50
        cnt_shift = 0
        With ws_front
            en = .Cells(r, 5)
            ini = .Cells(r, 10)
            str_wsname = Format(en, "00000") & "  " & ini
            With .Cells(r, 13)
                .BorderAround Weight:=xlThin
                .BorderAround Color:=RGB(255, 0, 0)
            End With
            'TIMESHEETS.Show
            'With TIMESHEETS.Label1
           '    .Caption = "Create: " & str_wsname
            '    .ForeColor = RGB(0, 0, 0)
            'End With
            
            'create worksheet
            trc = .Cells(r, 6)
            bb = Mid(trc, (Len(trc) - 3), 2)
            bc = Left(trc, 1)
            
            If bb = "CU" Then
                ws_mastercu.Visible = xlSheetVisible
                ws_mastercu.Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
            Else
                ws_masterst.Visible = xlSheetVisible
                ws_masterst.Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
            End If
            ActiveSheet.Name = str_wsname
            Set ws_target = wb_pstaff.Worksheets(str_wsname)
            ws_mastercu.Visible = xlSheetHidden
            ws_masterst.Visible = xlSheetHidden
            
            alias = .Cells(r, 11)
            Select Case trc 'True
                Case Left(trc, 4) = "WPRK"
                    ws_target.Tab.Color = RGB(169, 208, 142)
                Case Left(trc, 5) = "SE_CU"
                    ws_target.Tab.Color = RGB(244, 176, 132)
                Case Left(trc, 5) = "SE_ST"
                    ws_target.Tab.Color = RGB(198, 89, 17)
                Case trc = "SP_CU_1"
                    ws_target.Tab.Color = RGB(172, 185, 202)
                Case trc = "SP_CU_2"
                    ws_target.Tab.Color = RGB(172, 185, 202)
                Case trc = "SP_CU_7"
                    ws_target.Tab.Color = RGB(172, 185, 202)
                Case trc = "SP_CU_A"
                    ws_target.Tab.Color = RGB(132, 151, 176)
                Case trc = "SP_CU_B"
                    ws_target.Tab.Color = RGB(132, 151, 176)
                Case trc = "SP_CU_C"
                    ws_target.Tab.Color = RGB(132, 151, 176)
                Case Left(trc, 5) = "WBLVD"
                    ws_target.Tab.Color = RGB(84, 130, 53)
                Case Left(trc, 5) = "WP_ST"
                    ws_target.Tab.Color = RGB(47, 117, 181)
                Case Left(trc, 5) = "HP_ST"
                    ws_target.Tab.Color = RGB(60, 135, 204)
                Case Left(trc, 5) = "BP_ST"
                    ws_target.Tab.Color = RGB(155, 194, 230)
                Case Left(trc, 5) = "RP_ST"
                    ws_target.Tab.Color = RGB(180, 198, 231)
                Case Left(trc, 3) = "FLD"
                    ws_target.Tab.Color = RGB(157, 117, 245)
                Case Left(trc, 3) = "ZOO"
                    ws_target.Tab.Color = RGB(255, 217, 88)
                Case Else
                    ws_target.Tab.Color = RGB(255, 230, 153)
            End Select
        End With
        
        'is employee shifted
        With ws_target
            Debug.Print ws_target.Name
                For rr = 2 To 365 'days in post staff target worksheet
                    tdate = .Cells(rr, 2)
                    'Set ref_date = ws_schedule.Columns(1).Find(tdate)
                    'ref_date_row = ref_date.Row
                    ref_date_row = Application.WorksheetFunction.Match(CLng(tdate), ws_schedule.Columns(1), 0)
                    Debug.Print ref_date_row
                    cnt_alias = Application.WorksheetFunction.CountIf(ws_schedule.Rows(ref_date_row), alias)
                    If cnt_alias > 1 Then
                        MsgBox "Error: " & alias & " is found in more than 1 shift.", vbCritical, "ERROR. Row " & ref_date_row
                        Stop
                    ElseIf cnt_alias = 1 Then
                        Set rng_cfnd = ws_schedule.Rows(ref_date_row).Find(alias)
                        cfnd = rng_cfnd.Column
                        .Cells(rr, 3) = ws_schedule.Cells(ref_date_row, (cfnd - 2)) 'start time
                        .Cells(rr, 4) = ws_schedule.Cells(ref_date_row, (cfnd - 1)) 'end time
                        .Cells(rr, 6) = ws_schedule.Cells(2, (cfnd - 3)) 'crew
                        If bb = "ST" Then
                            .Cells(rr, 5) = 7.5
                        Else
                            .Cells(rr, 5) = 8
                        End If
                        cnt_shift = cnt_shift + 1
                        ws_front.Cells(r, 12) = Now
                        With ws_front.Cells(r, 13)
                            .Value = cnt_shift
                            .BorderAround LineStyle:=xlLineStyleNone
                            .BorderAround Color:=RGB(255, 255, 255)
                        End With
                    End If
                Next rr
                
           'End If
            .Protect
            .Visible = xlSheetHidden
       End With
    
    Next r
    ws_front.Protect
    Application.ScreenUpdating = True
    MsgBox "Process complete.", vbInformation, " "
    
    Application.DisplayAlerts = False
    wb_sschedule.Close
    Application.DisplayAlerts = True
    
End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,303
Office Version
  1. 365
Platform
  1. Windows
This line
Code:
Select Case trc 'True
should be
Code:
Select Case True
 

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
3,671
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Thank you Fluff! That was easy!
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,303
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,108,985
Messages
5,526,063
Members
409,685
Latest member
Davetom

This Week's Hot Topics

Top