A better way for If and Or condition in VBA

[danjuma]

Hello. I have the VBA code below. What it does is check if the data entered in a cell in column R is valid and then lock the cell and cells on the row from columns A to Q. What I am after is a better/more efficient for the condition "If Target = "123456" Or Target = "3245671" Or Target = "4227716" Then" as there are up to 20 different set of numbers I want to validate else I will have a very long If Or statement. Thanks

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("R:R")) Is Nothing Then Exit Sub
 ActiveSheet.Unprotect Password:="mypassword"
 If Target = "123456" Or Target = "3245671" Or Target = "4227716" Then
 Range("A" & Target.Row & ":R" & Target.Row).Locked = True
 End If
 ActiveSheet.Protect Password:="1855nom"
End Sub

 

[dmt32]

Hi,
try placing your numbers in an array & test for a match against that

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim arr         As Variant, MatchNumber As Variant
    
    arr = Array("123456", "3245671", "4227716")
    
    If Intersect(Target, Range("R:R")) Is Nothing Then Exit Sub
    
    ActiveSheet.Unprotect Password:="mypassword"
    MatchNumber = Application.Match(CStr(Target.Value), arr, 0)
    If Not IsError(MatchNumber) Then
        Range("A" & Target.Row & ":R" & Target.Row).Locked = True
    End If
    ActiveSheet.Protect Password:="1855nom"
End Sub

Dave

 

[Phuoc]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim strID As String
If Intersect(Target, Range("R:R")) Is Nothing Then Exit Sub
strID = "|123456|3245671|4227716|"
 ActiveSheet.Unprotect Password:="mypassword"
 If InStr(strID, "|" & Target.Value & "|") Then
 Range("A" & Target.Row & ":R" & Target.Row).Locked = True
 End If
 ActiveSheet.Protect Password:="1855nom"
 
End Sub

 

[Marc L]

Hi,​

​

or just using Select Case statement …​

 

[Peter_SSs]

Are the values being entered actually text or are they numbers?

Are you really unprotecting with one password and re-protecting with a different one? That will only work once!

 

[danjuma]

Are the values being entered actually text or are they numbers?

Are you really unprotecting with one password and re-protecting with a different one? That will only work once!

Hi, the values are number. The second password was a typo, was meant to change it to say "mypassword" before posting the code

 

[danjuma]

Thank you everyone for your responses and suggestions, will try them out!

 

[Peter_SSs]

Hi, the values are number. The second password was a typo

In that case you could try this. I don't know if it will be useful for you but you can include ranges of numbers in the select case, if you might have those. You would though need to consider if users might enter decimal numbers.

One other point is that your original code, and those suggested above, will error if the user changes multiple cells at once. For example there might be a copy/paste into column R, or entry with Ctrl+Enter or selection of a group of cells and 'Delete'. The code below works through each changed cell if there are multiple and locks, or not, that row depending on the col R value.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim changed As Range, c As Range
  
  Set changed = Intersect(Target, Columns("R"))
  If Not changed Is Nothing Then
    ActiveSheet.Unprotect Password:="mypassword"
    For Each c In changed
      Select Case c.Value
        Case 123456, 3245671, 4227716, 111000 To 111099, 246810 '<- Add more here as required
          c.EntireRow.Resize(, 18).Locked = True
      End Select
    Next c
    ActiveSheet.Protect Password:="mypassword"
  End If
End Sub

 

[danjuma]

In that case you could try this. I don't know if it will be useful for you but you can include ranges of numbers in the select case, if you might have those. You would though need to consider if users might enter decimal numbers.

One other point is that your original code, and those suggested above, will error if the user changes multiple cells at once. For example there might be a copy/paste into column R, or entry with Ctrl+Enter or selection of a group of cells and 'Delete'. The code below works through each changed cell if there are multiple and locks, or not, that row depending on the col R value.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim changed As Range, c As Range
 
  Set changed = Intersect(Target, Columns("R"))
  If Not changed Is Nothing Then
    ActiveSheet.Unprotect Password:="mypassword"
    For Each c In changed
      Select Case c.Value
        Case 123456, 3245671, 4227716, 111000 To 111099, 246810 '<- Add more here as required
          c.EntireRow.Resize(, 18).Locked = True
      End Select
    Next c
    ActiveSheet.Protect Password:="mypassword"
  End If
End Sub

Fantastic sir! Many thanks! Will try it out.

 

[Peter_SSs]

Cheers, hope it works for you.