VBA to force user to fill in cell or use required click button

[jski]

I’m constructing a VB code in a spreadsheet with the intent to force the user to complete certain required sections or they will be unable to print or close it. There are two high level issues I’m trying to solve with VB but I haven’t been too successful:

1.) If a certain cell is used (in this case H49) the user must click the sumbit button or they will be unable to close the spreadsheet. I think I’ve done this with the following code; however, I don’t think it is the most optimal:

Private Sub Workbook_Open()
'Sets the Submit button variable

Worksheets("TAP Form").Range("$A$999").Value = "CANT CLOSE"

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Forces the user to select the Submit button if designated cell has a date in it
'before being able to close the spreadsheet
If Range("$H$49") > 0 Then
    'If they have entered a date
    If Worksheets("TAP Form").Range("$H$49").Value > "0" Then
        'If they have not submitted the form
        If Worksheets("TAP Form").Range("$A$999").Value = "CANT CLOSE" Then
            'Doesn't let them close and gives them a message
            Worksheets("TAP Form").Range("$H$49").Select
            MsgBox "This TAP Form includes a financial plan." _
            & vbCrLf & vbNewLine & "Please submit the form before closing."
            Cancel = True
        End If
    End If
End If
End Sub

2.) The second item is the user needs to complete a certain field (in this case C69). If they don’t, the user receives a message, the field is highlighted in yellow and they are unable to close the workbook. Here what I’ve done with this bit:

Dim Start As Boolean
    Dim Rng1 As Range
     
    Dim Prompt As String, RngStr As String
    Dim Cell As Range
     'Set your ranges here
     'Rng1 is on sheet "TAP Form" and is Cell C69
    Set Rng1 = Sheets("TAP Form").Range("C69")
     'Message is returned if there are blank cells
    Prompt = "Please check your data ensuring all required " & _
    "cells are complete." & vbCrLf & vbNewLine & "You will not be able " & _
    "to close or save this workbook until you complete the required information." & _
    vbCrLf & vbNewLine & _
    "The following cells are incomplete and have been highlighted yellow:" _
    & vbCrLf & vbNewLine & vbNewLine & vbNewLine
    Start = True
     'Highlights the blank cells
    For Each Cell In Rng1
        If Cell.Value = vbNullString Then
            Cell.Interior.ColorIndex = 6 '** color yellow
            If Start Then RngStr = RngStr & Cell.Parent.Name & vbCrLf
            Start = False
            'Displays the field name and cell number.
            'The field name is a hard entry. Substitute RngStr for multiple fields
            RngStr = "Market Value of Assets" & vbCrLf & vbNewLine & _
            Cell.Address(False, False) & ", "
        Else
            Cell.Interior.ColorIndex = 0 '** no color
        End If
    Next
    If RngStr <> "" Then RngStr = Left$(RngStr, Len(RngStr) - 2)
    Start = True
    If RngStr <> "" Then RngStr = RngStr & vbCrLf & vbNewLine
        MsgBox Prompt & RngStr, vbCritical, "Incomplete Data"
        Cancel = True
    End If
     
    Set Rng1 = Nothing
End Sub

The problem I’m encountering is that each one of these bits of code counteracts the other. I’m at a point now where I’m totally unable to close the workbook. I think the two could be merged somehow to accommodate both needs. The end result would be that the user would be unable to close / save / print the workbook if cell H49 is used and the submit button was not clicked, and if cell C69 is left blank they would be unable to close /save / print as well. Finally, I’d like to force the user to Save As.

Guidance, instruction and general advice would be most helpful and appreciated. Thank in advance to all.

 

[techmob]

interesting stuff

i am after something very similar, i need to create a print button or have the built in print, check that data has been filled in to certain cells before it will print. kind of like yours

sorry i can't help with your problem

 

[jski]

I played with this a bit and went about it in a different way installing separate event code before print, save and close. I had to abandon the highlighting portion but it seems to work. Try this:

Private Sub Workbook_Open()

'Sets the Submit Button variable
Worksheets("TAP Form").Range("$A$999").Value = "CANT CLOSE"
End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)
'Disables printing unless user fills in required cells
Dim CheckC As Range
Set CheckC = Range("C69")
If Range("C69") = "" Then
MsgBox "You cannot print until required information has been completed." & _
vbCrLf & vbNewLine & "Market Value of Assets (C69)"
CheckC.Select
Cancel = True
End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Disables saving unless user fills in required cells
Dim CheckC As Range
Set CheckC = Range("C69")
If CheckC.Value = "" Then
MsgBox "You must enter the market value", vbCritical, "Incomplete Entry"
CheckC.Select
Cancel = True
End If
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Checks to see if a financial plan has been entered (H49) and then requires user to
'submit the form before closing
If Range("$H$49") > 0 Then
'If they have entered a date
If Worksheets("TAP Form").Range("$H$49").Value > "0" Then
'If they have not submitted the form
If Worksheets("TAP Form").Range("$A$999").Value = "CANT CLOSE" Then
'Doesn't let them close and gives them a message
Worksheets("TAP Form").Range("$H$49").Select
MsgBox "This TAP Form includes a financial plan." _
& vbCrLf & vbNewLine & "Please submit the form before closing."
Cancel = True
End If
End If
Else
'Mail_ActiveSheet = True
End If
End Sub

 

[techmob]

cheers

i had mine working wit this code

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    If Sheet1.Range("E10,M10,E13").Value = "" Then
         MsgBox "Cannot print until required cells have been completed! - You must fill in all information before you can print"
        Cancel = True
    End If
End Sub

that works however if i want to add any more cells to it for example

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    If Sheet1.Range("E10,M10,E13,M13,G15,K15,015,G18,K18,018,E23,I23,M23,Q23,V23,E28,M28,V28,E31,M31,O33,G33,V33,E38,O38,E41,O41,F45,G45,H45,I45,J45,K45,Q44,E49,F49,H49,G49,I49,J49,K49,L49").Value = "" Then
         MsgBox "Cannot print until required cells have been completed! - You must fill in all information before you can print"
        Cancel = True
    End If
End Sub

it gives an error, the same happens if i use yours with the amount of cells i need checking

maybe it is a simple fix but i cannot see it yet

thanks

 

[jski]

What's the error?

 

[techmob]

i am not in work now, so will tell you exactly tomorrow

however, it refers to this line

If Sheet1.Range("E10,M10,E13,M13,G15,K15,015,G18,K18,018,E23,I23,M23,Q23,V23,E28,M28,V28,E31,M31,O33,G33,V33,E38,O38,E41,O41,F45,G45,H45,I45,J45,K45,Q44,E49,F49,H49,G49,I49,J49,K49,L49").Value = "" Then
</pre>

 

[techmob]

I have done some modification

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    If Sheet1.Range("E10").Value = "" Then
         MsgBox "Please Enter a First Name"
        Cancel = True
    ElseIf Sheet1.Range("M10").Value = "" Then
         MsgBox "Please Enter a Surname"
        Cancel = True
    End If
End Sub

which works fine, but again if i add any more i get an error with the below code, can you see what i have done wrong?

it says compile error block if without end if

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    If Sheet1.Range("E10").Value = "" Then
         MsgBox "Please Enter a First Name"
        Cancel = True
    ElseIf Sheet1.Range("M10").Value = "" Then
         MsgBox "Please Enter a Surname"
        Cancel = True
     If Sheet1.Range("E13").Value = "" Then
         MsgBox "Please Enter a First Name"
        Cancel = True
    ElseIf Sheet1.Range("M13").Value = "" Then
         MsgBox "Please Enter a Surname"
        Cancel = True
         If Sheet1.Range("G15").Value = "" Then
         MsgBox "Please Enter a First Name"
        Cancel = True
    ElseIf Sheet1.Range("K15").Value = "" Then
         MsgBox "Please Enter a Surname"
        Cancel = True
         If Sheet1.Range("O15").Value = "" Then
         MsgBox "Please Enter a First Name"
        Cancel = True
    ElseIf Sheet1.Range("G18").Value = "" Then
         MsgBox "Please Enter a Surname"
        Cancel = True
         If Sheet1.Range("K18").Value = "" Then
         MsgBox "Please Enter a First Name"
        Cancel = True
    ElseIf Sheet1.Range("O18").Value = "" Then
         MsgBox "Please Enter a Surname"
        Cancel = True
         If Sheet1.Range("E23").Value = "" Then
         MsgBox "Please Enter a First Name"
        Cancel = True
    ElseIf Sheet1.Range("I23").Value = "" Then
         MsgBox "Please Enter a Surname"
        Cancel = True
         If Sheet1.Range("M23").Value = "" Then
         MsgBox "Please Enter a First Name"
        Cancel = True
    ElseIf Sheet1.Range("Q23").Value = "" Then
         MsgBox "Please Enter a Surname"
        Cancel = True
         If Sheet1.Range("V23").Value = "" Then
         MsgBox "Please Enter a First Name"
        Cancel = True
    ElseIf Sheet1.Range("E28").Value = "" Then
         MsgBox "Please Enter a Surname"
        Cancel = True
         If Sheet1.Range("M28").Value = "" Then
         MsgBox "Please Enter a First Name"
        Cancel = True
    ElseIf Sheet1.Range("V28").Value = "" Then
         MsgBox "Please Enter a Surname"
        Cancel = True
         If Sheet1.Range("E31").Value = "" Then
         MsgBox "Please Enter a First Name"
        Cancel = True
    ElseIf Sheet1.Range("M31").Value = "" Then
         MsgBox "Please Enter a Surname"
        Cancel = True
         If Sheet1.Range("O33").Value = "" Then
         MsgBox "Please Enter a First Name"
        Cancel = True
    ElseIf Sheet1.Range("G33").Value = "" Then
         MsgBox "Please Enter a Surname"
        Cancel = True
         If Sheet1.Range("V33").Value = "" Then
         MsgBox "Please Enter a First Name"
        Cancel = True
    ElseIf Sheet1.Range("E38").Value = "" Then
         MsgBox "Please Enter a Surname"
        Cancel = True
         If Sheet1.Range("O38").Value = "" Then
         MsgBox "Please Enter a First Name"
        Cancel = True
    ElseIf Sheet1.Range("E41").Value = "" Then
         MsgBox "Please Enter a Surname"
        Cancel = True
         If Sheet1.Range("O41").Value = "" Then
         MsgBox "Please Enter a First Name"
        Cancel = True
    ElseIf Sheet1.Range("F45").Value = "" Then
         MsgBox "Please Enter a Surname"
        Cancel = True
         If Sheet1.Range("G45").Value = "" Then
         MsgBox "Please Enter a First Name"
        Cancel = True
    ElseIf Sheet1.Range("H45").Value = "" Then
         MsgBox "Please Enter a Surname"
        Cancel = True
         If Sheet1.Range("I45").Value = "" Then
         MsgBox "Please Enter a First Name"
        Cancel = True
    ElseIf Sheet1.Range("J45").Value = "" Then
         MsgBox "Please Enter a Surname"
        Cancel = True
         If Sheet1.Range("K45").Value = "" Then
         MsgBox "Please Enter a First Name"
        Cancel = True
    ElseIf Sheet1.Range("Q44").Value = "" Then
         MsgBox "Please Enter a Surname"
        Cancel = True
         If Sheet1.Range("E49").Value = "" Then
         MsgBox "Please Enter a First Name"
        Cancel = True
    ElseIf Sheet1.Range("F49").Value = "" Then
         MsgBox "Please Enter a Surname"
        Cancel = True
    ElseIf Sheet1.Range("H49").Value = "" Then
         MsgBox "Please Enter a Surname"
        Cancel = True
         If Sheet1.Range("G49").Value = "" Then
         MsgBox "Please Enter a First Name"
        Cancel = True
    ElseIf Sheet1.Range("I49").Value = "" Then
         MsgBox "Please Enter a Surname"
        Cancel = True
         If Sheet1.Range("J49").Value = "" Then
         MsgBox "Please Enter a First Name"
        Cancel = True
    ElseIf Sheet1.Range("K49").Value = "" Then
         MsgBox "Please Enter a Surname"
        Cancel = True
         ElseIf Sheet1.Range("L49").Value = "" Then
         MsgBox "Please Enter a Surname"
        Cancel = True
    End If
End Sub