Select Case Code Not Working

A

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
4,564
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).
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Sort by date Sort by votes
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?
 
Upvote 0
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
 
Upvote 0
This line
Code: 
Select Case trc 'True
should be
Code: 
Select Case True
 
Upvote 0
You're welcome & thanks for the feedback
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Question
Select Case Range
2
Replies
10
Views
544
nemmi69
nemmi69
D
  • Question
Merge to codes under Private Sub Worksheet_Change event
2
Replies
11
Views
771
Dokat
D
N
  • Solved
sometimes problem with vba (Error 400)
Replies
5
Views
149
Domenic
D
Saher Naji
  • Solved
Sort values based on colors, then on values using VBA code
2
Replies
12
Views
1K
Saher Naji
Saher Naji
B
  • Solved
Select case with multiple case
2
Replies
10
Views
693
jasonb75
J

Forum statistics

Threads
1,214,643
Messages
6,120,702
Members
448,980
Latest member
CarlosWin

Share this page

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