Adding extra Or value to this VBA code

M

MeaclH

Board Regular
Joined
Apr 2, 2014
Messages
93
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi there,

I have this wonderful code running but would like to add a couple more values to consider when a value is changed.
Could you suggest a string of code to allow for multiple values to be considered.

Cheers,

Hayden
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Resp As String
Dim prevValue
prevValue = pVal

On Error GoTo ExitNow
Application.EnableEvents = False
If Target.CountLarge = 1 And Not Intersect(Target, Range("G11:T178")) Is Nothing Then '<--- Change Target Range Here
    If swapval = False Then
'---EDO/EDO-U
        If prevValue = "EDO" Or prevValue = "EDO-U" Then
            If InStr(Target.Value, "0" [B][COLOR=rgb(235, 107, 86)]MORE VALUES HERE)[/COLOR][/B] Then
                With Target
                    ActiveSheet.Unprotect
                    .Interior.Color = RGB(120, 210, 91)
                    .Font.Color = RGB(255, 0, 0)
                    'Input Box below. change text and title as needed:
                    Resp = Application.InputBox("You are allocating an open shift to a DAO on an EDO.         Please include details of when this shift was added and notify the DAO at the earliest opportunity.", _
                    Title:="Open shift added on an EDO")
                    ActiveSheet.Protect DrawingObjects:=False
                End With
            End If
        Else
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Sort by date Sort by votes
Consider multiple values where?
Did you notice that trying to colour vba code messes it up? I suppose the messed up part is the line you want to add conditions to?

Then I would suggest either add more OR operators or use a Select Case block in that sub. I'd probably vote for the latter. Perhaps replace that line with
VBA Code: 
Select Case True
    Case Instr(Target.Value,"0")> 0
        'do something
    Case Instr(Target.Value,"1")>0
        'do something
    Case Instr(Target.Value,"2")>0
        'do something
End Select
or simplify by passing a value to a function that uses that idea. I can't be clearer than that because what you're looking for in your string is not clear.
 
Upvote 0
Micron said:
Consider multiple values where?
Did you notice that trying to colour vba code messes it up? I suppose the messed up part is the line you want to add conditions to?

Then I would suggest either add more OR operators or use a Select Case block in that sub. I'd probably vote for the latter. Perhaps replace that line with
VBA Code: 
Select Case True
    Case Instr(Target.Value,"0")> 0
        'do something
    Case Instr(Target.Value,"1")>0
        'do something
    Case Instr(Target.Value,"2")>0
        'do something
End Select
or simplify by passing a value to a function that uses that idea. I can't be clearer than that because what you're looking for in your string is not clear.
Click to expand...
Hi mate, I realised that it did mess up after I posted. Thanks for picking up on it.

I am not super clever with VBA, most of my codes have come from you fine folk on here. I pick up where I can but can't seem to figure this one out.

Essentially, I would like the formatting of the cell to change as per the code, when the cell value is changed to contain either of the values below
0
MTP
ADMIN
TRAINING
ADHOC

Cheers,

Hayden
 
Upvote 0
What's not clear is whether or not Instr function is needed. I'm thinking the answer is no. The cell value will be one of those values? Or the cell value will be a string that contains one of those values? If the former, it is simpler. Approach would be to see if the cell equals one of those values and forget Instr. If the latter, the value would be within the string in the cell contents like
"This is a big fat 0"
"Ask the MTP"
"For ADMIN use only"
"Needs TRAINING"
"This is ADHOC"
so Instr would be required. I suspect it is not. Sorry for the questions but I like to be very clear on the inputs and outputs.

If it is an equals situation you could try replacing this line - If InStr(Target.Value, "0" ... Then
with this section
VBA Code: 
   Select Case Target.Value
      Case "0","MTP","ADMIN","TRAINING","ADHOC"
          With Target
             ActiveSheet.Unprotect
             .Interior.Color = RGB(120, 210, 91)
             .Font.Color = RGB(255, 0, 0)
             'Input Box below. change text and title as needed:
             Resp = Application.InputBox("You are allocating an open shift to a DAO on _
                 EDO. Please include details of when this shift was added and notify the _
                 DAO at the earliest opportunity.", _
                 Title:="Open shift added on an EDO")
             ActiveSheet.Protect DrawingObjects:=False
          End With
   End Select
Always test code that you find or are given on a copy of your workbook. Note: I assumed 0 is text and not a number data type since most of the other values are text. If 0 is formatted as a number, remove the quotes around it. I may have messed up your input box part, but I'd probably use a message box instead.
 
Last edited:
Upvote 0
You will need to remove the Instr from this line which should be just:
VBA Code: 
Select Case Target.Value
 
Upvote 0
Micron said:
True, so edited. I got sidetracked in all that code copying between Notepad and the thread.
Click to expand...
Ok thanks heaps friends. I am having a hard time following exactly what line of code I need to change. I have tried your suggestions but I am getting a If without block error.
Could you perhaps send back the code how it should be copied into my sheet?

This is what I currently have

Thanks heaps

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Resp As String
Dim prevValue
prevValue = pVal

On Error GoTo ExitNow
Application.EnableEvents = False
If Target.CountLarge = 1 And Not Intersect(Target, Range("G11:T178")) Is Nothing Then '<--- Change Target Range Here
    If swapval = False Then
'---EDO/EDO-U
        If prevValue = "EDO" Or prevValue = "EDO-U" Then
                If InStr(Target.Value, "0") Then
                    With Target
                    ActiveSheet.Unprotect
                    .Interior.Color = RGB(120, 210, 91)
                    .Font.Color = RGB(255, 0, 0)
                    'Input Box below. change text and title as needed:
                    Resp = Application.InputBox("You are allocating an open shift to a DAO on an EDO.         Please include details of when this shift was added and notify the DAO at the earliest opportunity.", _
                    Title:="Open shift added on an EDO")
                    ActiveSheet.Protect DrawingObjects:=False
                End With
            End If
        Else
'-------OFF/OFF-U
            If prevValue = "OFF" Or prevValue = "OFF-U" Then
                If InStr(Target.Value, "0") Then
                    With Target
                    ActiveSheet.Unprotect
                    .Interior.Color = RGB(255, 255, 1)
                    .Font.Color = RGB(255, 0, 0)
                    'Input Box below. change text and title as needed:
                    Resp = Application.InputBox("You are allocating an open shift to a DAO on a day OFF.         Please include details of when this shift was added and notify the DAO at the earliest opportunity.", _
                    Title:="Open shift added on a day OFF")
                        ActiveSheet.Protect DrawingObjects:=False
                    End With
                End If
            End If
        End If
    Else
        swapval = False
    End If
 
Upvote 0
You are missing something from the end. I'd rather have all of it if you don't mind, to avoid creating any mistakes. At the very least it's the End Sub line, but who knows it could be more than that.
 
Upvote 0
Micron said:
You are missing something from the end. I'd rather have all of it if you don't mind, to avoid creating any mistakes. At the very least it's the End Sub line, but who knows it could be more than that.
Click to expand...
sure mate. Thanks for taking the time.
As below.
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Resp As String
Dim prevValue
prevValue = pVal

On Error GoTo ExitNow
Application.EnableEvents = False
If Target.CountLarge = 1 And Not Intersect(Target, Range("G11:T178")) Is Nothing Then '<--- Change Target Range Here
    If swapval = False Then
'---EDO/EDO-U
        If prevValue = "EDO" Or prevValue = "EDO-U" Then
                If InStr(Target.Value, "0") Then
                    With Target
                    ActiveSheet.Unprotect
                    .Interior.Color = RGB(120, 210, 91)
                    .Font.Color = RGB(255, 0, 0)
                    'Input Box below. change text and title as needed:
                    Resp = Application.InputBox("You are allocating an open shift to a DAO on an EDO.         Please include details of when this shift was added and notify the DAO at the earliest opportunity.", _
                    Title:="Open shift added on an EDO")
                    ActiveSheet.Protect DrawingObjects:=False
                End With
            End If
        Else
'-------OFF/OFF-U
            If prevValue = "OFF" Or prevValue = "OFF-U" Then
                If InStr(Target.Value, "0") Then
                    With Target
                    ActiveSheet.Unprotect
                    .Interior.Color = RGB(255, 255, 1)
                    .Font.Color = RGB(255, 0, 0)
                    'Input Box below. change text and title as needed:
                    Resp = Application.InputBox("You are allocating an open shift to a DAO on a day OFF.         Please include details of when this shift was added and notify the DAO at the earliest opportunity.", _
                    Title:="Open shift added on a day OFF")
                        ActiveSheet.Protect DrawingObjects:=False
                    End With
                End If
            End If
        End If
    Else
        swapval = False
    End If
'---Absenteeism Details
    With Target
        Select Case .Value
            Case "SDO", "STFN", "CDO", "CTFN", "SPDO" '<- Add more trigger values here if required
                Resp = Application.InputBox("Please insert details of absenteeism", _
                Title:="Absenteeism Details")
            Case "OFF-U", "EDO-U" '<- Add more trigger values here if required
                Resp = Application.InputBox("Please insert details of DAO request to be marked unavailable on OFF/EDO.", _
                Title:="OFF/EDO Unavailability Details")
        End Select
    End With
'---DAO Shift Extension Confirmation/Decline
    With Target
        If InStr(1, .Value, "OK") > 0 Then
            Resp = Application.InputBox("Please enter details of when this shift extension was confirmed by the DAO. " & _
            "Including time and date and how it was confirmed", "DAO Shift Extension Confirmation", , , , , , 2)
        Else
            If InStr(1, .Value, "DEC") > 0 Then
                Resp = Application.InputBox("Please enter details of when this shift extension was declined by the DAO. " & _
                "Including time and date when it was declined", "DAO Shift Extension Declined", , , , , , 2)
        Else
            If InStr(1, .Value, "dec") > 0 Then
                Resp = Application.InputBox("Please enter details of when this shift extension was declined by the DAO. " & _
                "Including time and date when it was declined", "DAO Shift Extension Declined", , , , , , 2)
        Else
            If InStr(1, .Value, "?") > 0 Then
                Resp = Application.InputBox("Please enter details of when this shift extension was added to the DAOs roster. " & _
                "Including time and date when it was added", "DAO Shift Extension added", , , , , , 2)
        Else
            If InStr(1, .Value, "ok") > 0 Then
            Resp = Application.InputBox("Please enter details of when this shift extension was confirmed by the DAO. " & _
            "Including time and date and how it was confirmed", "DAO Shift Extension Confirmation", , , , , , 2)
                        End If
                    End If
                End If
            End If
        End If
    End With
    Call AddComment(Target, Resp)
End If

ExitNow:
Application.EnableEvents = True
End Sub
 
Upvote 0
This compiles if I add a couple of undeclared variables, but of course I can't test it. If I didn't say it before, try provided code on a copy of your workbook(s). If this isn't what you're after then I guess I'm not understanding the request. What's odd is that your code already seems to have made use of the suggestion down here:
VBA Code: 
Select Case .Value
            Case "SDO", "STFN", "CDO", "CTFN", "SPDO" '<- Add more trigger values here if required
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Resp As String
Dim prevValue

prevValue = pVal
On Error GoTo ExitNow
Application.EnableEvents = False
If Target.CountLarge = 1 And Not Intersect(Target, Range("G11:T178")) Is Nothing Then '<--- Change Target Range Here
    If swapval = False Then
'---EDO/EDO-U
If prevValue = "EDO" Or prevValue = "EDO-U" Then
    Select Case Target.Value
      Case "0","MTP","ADMIN","TRAINING","ADHOC"
          With Target
             ActiveSheet.Unprotect
             .Interior.Color = RGB(120, 210, 91)
             .Font.Color = RGB(255, 0, 0)
             'Input Box below. change text and title as needed:
             Resp = Application.InputBox("You are allocating an open shift to a DAO on _
                 EDO. Please include details of when this shift was added and notify the _
                 DAO at the earliest opportunity.", _
                 Title:="Open shift added on an EDO")
             ActiveSheet.Protect DrawingObjects:=False
          End With
   End Select
Else
'-------OFF/OFF-U
'rest of your code here
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

M
  • Question Question
Prevent worksheet change from triggering when similar macro is executed?
Replies
1
Views
139
AlphaFrog
AlphaFrog
M
  • Question Question
Sheet code runtime error 1004
Replies
3
Views
189
MeaclH
M
M
  • Question Question
Copied sheet code to new file and lost some functionality....not sure how/why
Replies
5
Views
117
MeaclH
M
M
  • Question Question
Where to protect sheet in this code?
Replies
1
Views
92
Micron
M
M
  • Question Question
VLOOKUP?
Replies
1
Views
218
MeaclH
M

Forum statistics

Threads
1,224,520
Messages
6,179,270
Members
452,902
Latest member
Knuddeluff

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