Mandatory Cell Based on Value in Another Cell

I currently have some VBA that when you click a button, it highlights any cells that are mandatory on that sheet and that are currently empty ... so the user can't move on without completing the required cells.  

What I would like to do is add another IF statement into the code that makes other cells mandatory dependent on what is put in a cell on  previous sheet.  For eample:

If cell Q47 on worksheet "Part 2" contains the word "dog" or "cat", then the following cells on worksheet Part 3 become mandatory - AI15, BE15, AI36 .... However, if cell Q47 doesn't contain these words, then rows 14 to 36 of the Part 3 are either not mandatory .... or ideally are not mandatory and become hidden.

If the cells are made mandatory, then I'm looking at the same as before ... When the same button is clicked then it looks at the new IF statement in the first instance, and if there is nothing in the cells then they become highlighted, and will show an Oops2.Show  Form.  .... Once the client has put something in and clicks the button again it then moves onto the code below:

Sub Sheet3button()
ActiveSheet.Unprotect "xxxxx"
complete = True  'use to flag if all cells are filled in
Application.ScreenUpdating = False
For Each Cell In Worksheets("Part 3").Range("Q11,AI11,AZ11,Q12,Q23,AI23,BE23")
If Cell.Value = "" Then
Cell.Interior.Color = RGB(255, 255, 0)
complete = False  'flags missing entry
Else
Cell.Interior.ColorIndex = -4142  'Clears format if the cell is not Blank
End If
Next Cell
For Each Cell In Worksheets("Part 3 ").Range("Q26,AS26,Q27,AS27,Q28,AS28,Q29")
If Cell.Value = "" Then
Cell.Interior.Color = RGB(255, 255, 0)
complete = False  'flags missing entry
Else
Cell.Interior.ColorIndex = -4142   'Clears format if the cell doesn't contain Click here
End If
Next Cell
If complete = False Then
Oops.Show
Else
Application.Goto Reference:=Range("A1"), _
Scroll:=True
ActiveSheet.Protect "xxxxx"
Part3SpellCheck.Show
Application.ScreenUpdating = True
End If
End Sub

Open in new window


Any help would be appreciated.
Dan FullerAsked:
Who is Participating?
 
Ejgil HedegaardCommented:
Try the code below.
I think you have misspelled the sheet name in line 13.
To avoid that, I have added variable declaration (the Dim statements at the top), and defined sheet variables, so only set once.
You should always declare variables.
Then misspelled variables will be detected on compiling, before run.
The first line in below code "Option Explicit" tells VBA that variables must be declared.
Turn it on in the menu Tools-Options, then new modules will always have it.

The comments show what is new and changed.
Cells in the first loop within rows 14 to 36 moved to second loop, and above mentioned cells added.
Rows will be hidden if not cat or dog in Part 2 Q47.
I have added Indent to the code to make it more readable.

Option Explicit

Sub Sheet3button()
    Dim ws2 As Worksheet, ws3 As Worksheet  'New
    Dim complete As Boolean 'New
    Dim Cell As Range   'New
       
    Set ws2 = Worksheets("Part 2")  'New
    Set ws3 = Worksheets("Part 3")  'New
    
    ws3.Unprotect "xxxxx"   'Changed
    complete = True  'use to flag if all cells are filled in
    Application.ScreenUpdating = False
    For Each Cell In ws3.Range("Q11,AI11,AZ11,Q12")   'Changed
        If Cell.Value = "" Then
            Cell.Interior.Color = RGB(255, 255, 0)
            complete = False  'flags missing entry
        Else
            Cell.Interior.ColorIndex = -4142  'Clears format if the cell is not Blank
        End If
    Next Cell
    
    If LCase(ws2.Range("Q47")) = "cat" Or LCase(ws2.Range("Q47")) = "dog" Then  'New
        ws3.Rows("14:36").Hidden = False    'New
        For Each Cell In ws3.Range("Q26,AS26,Q27,AS27,Q28,AS28,Q29,Q23,AI23,BE23,AI15,BE15,AI36") 'Changed
            If Cell.Value = "" Then
                Cell.Interior.Color = RGB(255, 255, 0)
                complete = False  'flags missing entry
            Else
                Cell.Interior.ColorIndex = -4142   'Clears format if the cell doesn't contain Click here
            End If
        Next Cell
    Else    'New
        ws3.Rows("14:36").Hidden = True 'New
    End If  'New
    
    If complete = False Then
        Oops.Show
    Else
        Application.Goto Reference:=Range("A1"), _
        Scroll:=True
        ws3.Protect "xxxxx" 'Changed
        Part3SpellCheck.Show
        Application.ScreenUpdating = True
    End If
End Sub

Open in new window

0
 
Dan FullerAuthor Commented:
That's brilliant thank you ... I'll try it out today!
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.