VBA to check cells and unprotect if necessary

I have a protected sheet where the user can input in certain cells only.

I would like VBA that will look for the text "other" in C15:D36, and if any of those cells contain any part of the word "other", I want it to unlock the Total Miles cell in that particular row.  For example:  if C15 OR D15 has any part of the text "other", I want code to unlock H15 so the user can input the total miles (overwriting the formula in that cell).  I found some code (see below) that I edited but not working as I expected.  I can't get 1 row to work let alone 22 rows.  Please help. (see also the file attached for screen shot) Thank you in advance.

Private Sub CellValueProtect(ByVal Target As Range)
    If Active.sheet.Range("C15:D15") = "Other" Then
        Active.sheet.Range("H15").Locked = False
    Else: Active.sheet.Range("H15").Locked = True
    End If
    If Active.sheet.Range("C16:D16") = "Other" Then
        Active.sheet.Range("H16").Locked = False
    Else: Active.sheet.Range("H16").Locked = True
    End If
    If Active.sheet.Range("C17:D17") = "Other" Then
        Active.sheet.Range("H17").Locked = False
    Else: Active.sheet.Range("H17").Locked = True
    End If
    If Active.sheet.Range("C18:D18") = "Other" Then
        Active.sheet.Range("H18").Locked = False
    Else: Active.sheet.Range("H18").Locked = True
    End If
           
End Sub
Screen-shot-of-sheet.JPG
Kim DygertAsked:
Who is Participating?
 
Rgonzo1971Connect With a Mentor Commented:
shorter
Private Sub Worksheet_Change(ByVal Target As Range)
    Me.Unprotect
    If Not Intersect(Target, Range("C15:D18")) Is Nothing Then
        Me.Range("H15:H18").Locked = True
        If Me.Cells(Target.Row, "C") Like "Other*" Or Me.Cells(Target.Row, "D") Like "Other*" Then
            Me.Cells(Target.Row, "H").Locked = False
        End If
    End If
    Me.Protect
End Sub

Open in new window

0
 
Rgonzo1971Commented:
HI,

pls try insert the code in the module of the sheet
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("C15:D18")) Is Nothing Then
        If Me.Range("C15") = "Other" Or Me.Range("D15") = "Other" Then
            Me.Range("H15").Locked = False
        Else: Me.Range("H15").Locked = True
        End If
        If Me.Range("C16") = "Other" Or Me.Range("D16") = "Other" Then
            Me.Range("H16").Locked = False
        Else: Me.Range("H16").Locked = True
        End If
        If Me.Range("C17") = "Other" Or Me.Range("D17") = "Other" Then
            Me.Range("H17").Locked = False
        Else: Me.Range("H17").Locked = True
        End If
        If Me.Range("C18") = "Other" Or Me.Range("D18") = "Other" Then
            Me.Range("H18").Locked = False
        Else: Me.Range("H18").Locked = True
        End If
    End If
End Sub

Open in new window

Regards
0
 
Rgonzo1971Commented:
simplified
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("C15:D18")) Is Nothing Then
        Me.Range("H15:H18").Locked = True
        If Me.Range("C15") = "Other" Or Me.Range("D15") = "Other" Then
            Me.Range("H15").Locked = False
        End If
        If Me.Range("C16") = "Other" Or Me.Range("D16") = "Other" Then
            Me.Range("H16").Locked = False
        End If
        If Me.Range("C17") = "Other" Or Me.Range("D17") = "Other" Then
            Me.Range("H17").Locked = False
        End If
        If Me.Range("C18") = "Other" Or Me.Range("D18") = "Other" Then
            Me.Range("H18").Locked = False
        End If
    End If
End Sub

Open in new window

0
Cloud Class® Course: Ruby Fundamentals

This course will introduce you to Ruby, as well as teach you about classes, methods, variables, data structures, loops, enumerable methods, and finishing touches.

 
Kim DygertAuthor Commented:
This did not work either.  No error, just did not unlock cell H15 with "other" in the description of C15 or D15.
0
 
Rgonzo1971Commented:
then try
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("C15:D18")) Is Nothing Then
        Me.Range("H15:H18").Locked = True
        If lcase(Me.Range("C15")) like "*other*" Or lcase(Me.Range("D15")) like "*other*"  Then
            Me.Range("H15").Locked = False
        End If
        If lcase(Me.Range("C16")) like "*other*" Or lcase(Me.Range("D16")) like "*other*"  Then
            Me.Range("H16").Locked = False
        End If
        If lcase(Me.Range("C17")) like "*other*" Or lcase(Me.Range("D17")) like "*other*"  Then
            Me.Range("H17").Locked = False
        End If
        If lcase(Me.Range("C18")) like "*other*" Or lcase(Me.Range("D18")) like "*other*"  Then
            Me.Range("H18").Locked = False
        End If
    End If

Open in new window

End Sub
0
 
Kim DygertAuthor Commented:
We must be missing something... still not working.
0
 
Rgonzo1971Commented:
Could you send a dummy?
0
 
Kim DygertAuthor Commented:
Here is a sample of the workbook.... thank you for looking into this for me. :)
Sample_Mileage_Portfolio_Rate_545.xlsm
0
 
Rgonzo1971Commented:
then try
Private Sub Worksheet_Change(ByVal Target As Range)
    Me.Unprotect
    If Not Intersect(Target, Range("C15:D18")) Is Nothing Then
        Me.Range("H15:H18").Locked = True
        If Me.Range("C15") Like "Other*" Or Me.Range("D15") Like "Other*" Then
            Me.Range("H15").Locked = False
        End If
        If Me.Range("C16") Like "Other*" Or Me.Range("D16") Like "Other*" Then
            Me.Range("H16").Locked = False
        End If
        If Me.Range("C17") Like "Other*" Or Me.Range("D17") Like "Other*" Then
            Me.Range("H17").Locked = False
        End If
        If Me.Range("C18") Like "Other*" Or Me.Range("D18") Like "Other*" Then
            Me.Range("H18").Locked = False
        End If
    End If
    Me.Protect
End Sub

Open in new window

in the Sheet2 module
Sample_Mileage_Portfolio_Rate_545v1.xlsm
0
 
Kim DygertAuthor Commented:
You are AMAZING!!  Thank you so much... what was I doing wrong?  Should I put this code in all the sheets modules using it?
0
 
Rgonzo1971Commented:
that's right and first unprotect before making a locking change
0
 
Kim DygertAuthor Commented:
Thank you once again - You are my hero!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.