+ Reply to Thread
Results 1 to 12 of 12

Shorten the Code - Use CASE ?

Hybrid View

captvsharma Shorten the Code - Use CASE ? 03-24-2022, 04:58 AM
AskMeAboutExcel Re: Shorten the Code - Use... 03-24-2022, 05:11 AM
captvsharma Re: Shorten the Code - Use... 03-24-2022, 06:10 AM
Andy Pope Re: Shorten the Code - Use... 03-24-2022, 05:18 AM
captvsharma Re: Shorten the Code - Use... 03-24-2022, 06:15 AM
captvsharma Re: Shorten the Code - Use... 03-24-2022, 08:06 AM
AskMeAboutExcel Re: Shorten the Code - Use... 03-24-2022, 05:55 AM
AskMeAboutExcel Re: Shorten the Code - Use... 03-24-2022, 06:52 AM
captvsharma Re: Shorten the Code - Use... 03-24-2022, 08:12 AM
captvsharma Re: Shorten the Code - Use... 03-24-2022, 08:08 AM
Andy Pope Re: Shorten the Code - Use... 03-25-2022, 04:04 AM
captvsharma Re: Shorten the Code - Use... 03-25-2022, 04:28 AM
  1. #1
    Registered User
    Join Date
    08-19-2020
    Location
    London
    MS-Off Ver
    365
    Posts
    22

    Shorten the Code - Use CASE ?

    Hello

    What would be a smarter way to shorten the below code please ?

    Kind regards
    Vivek

    Private Sub Worksheet_Change(ByVal Target As Range)
        
        If Not Intersect(Target(1), [D4:D400]) Is Nothing And (Target(1).Text) = "On Site" Then
            Application.EnableEvents = False
            Rows(Target(1).Row).Columns("E:AB").Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = -0.499984740745262
                .PatternTintAndShade = 0
            End With
            Application.EnableEvents = True
        End If
        
        If Not Intersect(Target(1), [D4:D400]) Is Nothing And (Target(1).Text) = "Travel Air" Then
            Application.EnableEvents = False
            Rows(Target(1).Row).Columns("E:AB").Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = -0.499984740745262
                .PatternTintAndShade = 0
            End With
            Application.EnableEvents = True
        End If
        
        If Not Intersect(Target(1), [D4:D400]) Is Nothing And (Target(1).Text) = "No Work" Then
            Application.EnableEvents = False
            Rows(Target(1).Row).Columns("E:AB").Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = -0.499984740745262
                .PatternTintAndShade = 0
            End With
            Application.EnableEvents = True
        End If
        
        If Not Intersect(Target(1), [D4:D400]) Is Nothing And (Target(1).Text) = "Travel Road" Then
            Application.EnableEvents = False
            Rows(Target(1).Row).Columns("E:AB").Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            Application.EnableEvents = True
        End If
        
           If Not Intersect(Target(1), [D4:D400]) Is Nothing And (Target(1).Text) = "Virtual" Then
            Application.EnableEvents = False
            Rows(Target(1).Row).Columns("E:AB").Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            Application.EnableEvents = True
        End If
    
    End Sub
    Last edited by captvsharma; 03-25-2022 at 04:28 AM.

  2. #2
    Valued Forum Contributor
    Join Date
    01-07-2022
    Location
    Europe
    MS-Off Ver
    Office 365
    Posts
    473

    Re: Shorten the Code - Use CASE ?

    Do you mean something like this (not tested)?

    Private Sub Worksheet_Change(ByVal Target As Range)
        
        If Not Intersect(Target(1), [D4:D400]) Is Nothing Then
            Select Case Target(1).Text
            Case "On Site", "Travel Air", "No Work", "Travel Road", "Virtual"
    
                Application.EnableEvents = False
                Rows(Target(1).Row).Columns("E:AB").Select
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorDark1
                    .TintAndShade = -0.499984740745262
                    .PatternTintAndShade = 0
                End With
                Application.EnableEvents = True
            End Select
        End If
    End Sub
    <<< If you have valued anyone's contributions in this thread, please click * to thank them for their efforts

  3. #3
    Registered User
    Join Date
    08-19-2020
    Location
    London
    MS-Off Ver
    365
    Posts
    22

    Re: Shorten the Code - Use CASE ?

    Thanks and gives the idea

  4. #4
    Forum Guru Andy Pope's Avatar
    Join Date
    05-10-2004
    Location
    Essex, UK
    MS-Off Ver
    O365
    Posts
    20,482

    Re: Shorten the Code - Use CASE ?

    A little shorter

        If Not Intersect(Target(1), [D4:D400]) Is Nothing Then
            Select Case UCase(Target(1).Text)
            Case "ON SITE", "TRAVEL AIR", "NO WORK"
                Application.EnableEvents = False
                With Rows(Target(1).Row).Columns("E:AB").Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorDark1
                    .TintAndShade = -0.499984740745262
                    .PatternTintAndShade = 0
                End With
                Application.EnableEvents = True
            Case "TRAVEL ROAD", "VIRTUAL"
                Application.EnableEvents = False
                With Rows(Target(1).Row).Columns("E:AB").Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorDark1
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
                Application.EnableEvents = True
            Case Else
                ' maybe reset E:AB
            End Select
        End If
    Only check in D4:D400 once, then check for text.
    The code is not case sensitive "on site" and "On Site" will both cause the change.
    Cheers
    Andy
    www.andypope.info

  5. #5
    Registered User
    Join Date
    08-19-2020
    Location
    London
    MS-Off Ver
    365
    Posts
    22

    Re: Shorten the Code - Use CASE ?

    Andy , very clear and extremely succinct.

    How can I build in multiple criteria in the same code ? e.g. If "ON SITE" is on Saturday or Sunday ( Date is Column C) than remove the TintandShade ?

  6. #6
    Registered User
    Join Date
    08-19-2020
    Location
    London
    MS-Off Ver
    365
    Posts
    22

    Re: Shorten the Code - Use CASE ?

    Hello

    Please help with building a nested CASE statement. If Column C (date) is a weekend i.e. Saturday or Sunday then the Tint for "On Site Work" should be removed. How can I achieve that in the code please ?
    [CODE]
    Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target(1), [D4:D400]) Is Nothing Then
    Select Case UCase(Target(1).Text)
    Case "ON SITE WORK", "TRAVEL TO/FROM", "NO AUDIT WORK"
    Application.EnableEvents = False
    With Rows(Target(1).Row).Columns("E:AB").Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.499984740745262
    .PatternTintAndShade = 0
    End With
    Application.EnableEvents = True
    Case "TRAVEL WITHIN", "VIRTUAL WORK"
    Application.EnableEvents = False
    With Rows(Target(1).Row).Columns("E:AB").Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0
    .PatternTintAndShade = 0
    End With
    Application.EnableEvents = True
    Case Else
    Application.EnableEvents = False
    With Rows(Target(1).Row).Columns("E:AB").Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0
    .PatternTintAndShade = 0
    End With
    Application.EnableEvents = True
    End Select
    End If

    End Sub
    Last edited by captvsharma; 03-24-2022 at 08:09 AM.

  7. #7
    Valued Forum Contributor
    Join Date
    01-07-2022
    Location
    Europe
    MS-Off Ver
    Office 365
    Posts
    473

    Re: Shorten the Code - Use CASE ?

    good spot, hadn't picked up the different .TintAndShade parameters

  8. #8
    Valued Forum Contributor
    Join Date
    01-07-2022
    Location
    Europe
    MS-Off Ver
    Office 365
    Posts
    473

    Re: Shorten the Code - Use CASE ?

    you could nest the case, or put simple IF...THEN statements on individual lines (depending on how complex they are)

  9. #9
    Registered User
    Join Date
    08-19-2020
    Location
    London
    MS-Off Ver
    365
    Posts
    22

    Re: Shorten the Code - Use CASE ?

    Thanks Sir. Please help with building a nested CASE statement. If Column C (date) is a weekend i.e. Saturday or Sunday then the Tint for "On Site Work" should be removed. How can I achieve that in the code, please ? Excel spreadsheet attached if it helps.

  10. #10
    Registered User
    Join Date
    08-19-2020
    Location
    London
    MS-Off Ver
    365
    Posts
    22

    Re: Shorten the Code - Use CASE ?

    Attaching the Excel sheet for understanding.
    Attached Files Attached Files

  11. #11
    Forum Guru Andy Pope's Avatar
    Join Date
    05-10-2004
    Location
    Essex, UK
    MS-Off Ver
    O365
    Posts
    20,482

    Re: Shorten the Code - Use CASE ?

    add a check of weekday

                        If Application.Weekday(DateValue(Target.Offset(0, -1).Value), 2) > 5 Then
                            .TintAndShade = 0
                        Else
                            .TintAndShade = -0.499984740745262
                        End If
    In the weekday function I used 2 so the values of Saturday and Sunday were 6 and 7. This makes the conditional test easier.

  12. #12
    Registered User
    Join Date
    08-19-2020
    Location
    London
    MS-Off Ver
    365
    Posts
    22

    Re: Shorten the Code - Use CASE ?

    Andy - wow ! What a great code and thanks a lot. You are awesome.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. [SOLVED] Shorten VBA code
    By DiCaver in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 01-09-2018, 05:40 AM
  2. shorten code vba
    By wildonln in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 05-07-2016, 03:50 PM
  3. [SOLVED] Represent (define?) a section of code with a variable (shorten long code lines)?
    By Gene@action in forum Excel Programming / VBA / Macros
    Replies: 4
    Last Post: 02-01-2016, 03:59 PM
  4. Hi all, can you please help me to shorten this code as much as possible
    By boddulus in forum Excel Programming / VBA / Macros
    Replies: 14
    Last Post: 08-31-2014, 07:31 AM
  5. [SOLVED] Very inefficient code because of different sizes of arrays, how do i shorten my code?
    By Brammer88 in forum Excel Programming / VBA / Macros
    Replies: 4
    Last Post: 12-28-2012, 04:49 PM
  6. [SOLVED] Disregard case in VBA code. (UCase, LCase, Select Case)
    By Orestees in forum Excel Programming / VBA / Macros
    Replies: 17
    Last Post: 09-07-2012, 12:12 PM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1