Excel 2010 - Mandatory Fields Required

Question

Hello

I have an excel form that requires several cells to be completed before it can be saved.

The cells are not connected in a column or row, they are spread throughout the Worksheet.

I have a VB code example that mentions only one cell reference as follows:-

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    If Sheets("Sheet1").Range("B5").Value = "" Then

        MsgBox "Pls enter value in B5"

        Cancel = True 'cancels the save event

    End If

End Sub

Can I tweak the above code to apply to many cells ?? i.e. A3, B7, C1, D9, etc.

All help would be much appreciated

Many thanks

Ann

Answer 1

The "easy" way to do this would be to simply copy the IF ... End If block and paste and edit it several times within the routine, as:

Private Sub Workbook_BeforeSave(ByVal SaveAsUIAs Boolean, Cancel As Boolean)

   If Sheets("Sheet1").Range("B5").Value = "" Then

     MsgBox "Pls enter value in B5"

     Cancel = True 'cancels the save event

     Exit Sub

   End If 

   If Sheets("Sheet1").Range("A3").Value = "" Then 

     MsgBox "Pls enter value in A3"

     Cancel = True 'cancels the save event

     Exit Sub

   End If

End Sub

A little easier to modify would be like this

Private Sub Workbook_BeforeSave(ByVal SaveAsUIAs Boolean, Cancel As Boolean)

  Dim whatCell as String

  whatCell = "B5"

  If Sheets("Sheet1").Range(whatCell).Value = "" Then

     MsgBox "Pls enter value in " & whatCell

     Cancel = True 'cancels the save event

     Exit Sub

   End If 

   whatCell = "A3"

  If Sheets("Sheet1").Range(whatCell).Value = "" Then

     MsgBox "Pls enter value in " & whatCell 

     Cancel = True 'cancels the save event

     Exit Sub

   End If

End Sub

Answer 2

Here is the complete solution code and my reasoning behind it.

There is an inate problem in setting things up to where you cannot save or close the workbook until all fields are completed -- how do you save a "clean" copy of it for distribution and use?!

I solved that issue by using the Workbook_OPEN() event to examine the cells that must be completed by the user for a specific entry and if that entry is found, it is deleted, leaving an empty cell for the user to fill with actual data.  I chose "~~~" as that specific entry.

I then elected to use the Workbook_BeforeClose() process as the point to do the testing instead of the _BeforeSave() process.  This allows the user to save the workbook while working with it, but not be able to close it until all data has been entered.

An added twist was the use of merged cells for pretty much all data entry areas, and that has to be dealt with specifically when clearing the ~~~ entries from the cells, while keeping in mind that somewhere along the line, a data entry cell may not be a merged group.

With all of that, here is the complete code for the ThisWorkbook code module that I have provided back to you in the workbook you sent to me:

Option Explicit

  'these values are used by both the _Open() and _BeforeClose() processes

  'we declare them here so they only need to be declared once.

  Const sName = "Daily Project Safety Report"

  Const toBeRemoved = "~~~" ' the dummy value to use to save seed workbook.

  Dim checkWS As Worksheet

  Dim whatCell_1 As String

  Dim whatCell_2 As String ' for East/West testing

  Dim RLC As Long ' Row Loop Counter

Private Sub Workbook_Open()

  'this process looks at the cells of interest and if they

  'contain ~~~ then the entry is deleted, leaving an empty cell.

  'this will then allow the tests for empty cells to take

  'place later while allowing you to work with the workbook

  'for maintenance and you can put ~~~ into all data entry cells

  'and be able to save and distribute the workbook to others for

  'normal use.

  '

  'merged cells create special problems and we deal with them as needed

  Application.ScreenUpdating = False ' to prevent screen flicker

  Set checkWS = ThisWorkbook.Worksheets(sName)

  On Error Resume Next ' so our merged cells tests work properly

  whatCell_1 = "E3"

  If Trim(checkWS.Range(whatCell_1)) = toBeRemoved Then

    checkWS.Range(whatCell_1).MergeArea.ClearContents

    If Err <> 0 Then

      checkWS.Range(whatCell_1).ClearContents

      Err.Clear

    End If

  End If

  whatCell_1 = "F4"

  If Trim(checkWS.Range(whatCell_1)) = toBeRemoved Then

    checkWS.Range(whatCell_1).MergeArea.ClearContents

    If Err <> 0 Then

      checkWS.Range(whatCell_1).ClearContents

      Err.Clear

    End If

  End If

  whatCell_1 = "I4"

  If Trim(checkWS.Range(whatCell_1)) = toBeRemoved Then

    checkWS.Range(whatCell_1).MergeArea.ClearContents

    If Err <> 0 Then

      checkWS.Range(whatCell_1).ClearContents

      Err.Clear

    End If

  End If

  For RLC = 5 To 7

    whatCell_1 = "E" & CStr(RLC)

    If Trim(checkWS.Range(whatCell_1)) = toBeRemoved Then

      checkWS.Range(whatCell_1).MergeArea.ClearContents

      If Err <> 0 Then

        checkWS.Range(whatCell_1).ClearContents

        Err.Clear

      End If

    End If

  Next ' end RLC loop

  For RLC = 3 To 7

    whatCell_1 = "O" & CStr(RLC)

    If Trim(checkWS.Range(whatCell_1)) = toBeRemoved Then

      checkWS.Range(whatCell_1).MergeArea.ClearContents

      If Err <> 0 Then

        checkWS.Range(whatCell_1).ClearContents

        Err.Clear

      End If

    End If

  Next ' end RLC loop

  For RLC = 10 To 12

    whatCell_1 = "K" & CStr(RLC)

    If Trim(checkWS.Range(whatCell_1)) = toBeRemoved Then

      checkWS.Range(whatCell_1).MergeArea.ClearContents

      If Err <> 0 Then

        checkWS.Range(whatCell_1).ClearContents

        Err.Clear

      End If

    End If

  Next ' end RLC loop

  'reset error trapping - allow system to handle them again

  On Error GoTo 0

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

'

'if you want to make changes to the code or form and then

'be able to save the changes without having to make entries

'then make this one line of code active while doing that

'and then later make it a comment again to have the

'sheet force entries when used.

'Exit Sub

'but in order to save the workbook with empty cells for use

'you'll need to open the workbook but disable macros! then

'make sure your cells are empty as required, comment out

'the Exit Sub statement above and then save the workbook.

'

  'make checkWS refer to the sheet we want to examine

  Set checkWS = ThisWorkbook.Worksheets(sName)

  'the Project Name entry

  whatCell_1 = "E3"

  If Trim(checkWS.Range(whatCell_1)) = "" Or _

   IsEmpty(checkWS.Range(whatCell_1)) Then

    MsgBox "Please provide entry into cell " & whatCell_1

    Cancel = True

    Exit Sub

  End If

  'this is a 2-cell test I have assumed that either

  'one or the other must be completed, but not both

  'the East/West entries

  whatCell_1 = "F4"

  whatCell_2 = "I4"

  If (Trim(checkWS.Range(whatCell_1)) = "" Or _

   IsEmpty(checkWS.Range(whatCell_1))) _

   And _

   (Trim(checkWS.Range(whatCell_2)) = "" Or _

   IsEmpty(checkWS.Range(whatCell_2))) Then

    MsgBox "You must provide an East/West entry at " _

     & whatCell_1 & " or " & whatCell_2

    Cancel = True

    Exit Sub

  End If

  'the Rep's Name entry

  whatCell_1 = "O4"

  If Trim(checkWS.Range(whatCell_1)) = "" Or _

   IsEmpty(checkWS.Range(whatCell_1)) Then

    MsgBox "Please provide entry into cell " & whatCell_1

    Cancel = True

    Exit Sub

  End If

  'the Project/Work Order entry

  whatCell_1 = "E5"

  If Trim(checkWS.Range(whatCell_1)) = "" Or _

   IsEmpty(checkWS.Range(whatCell_1)) Then

    MsgBox "Please provide entry into cell " & whatCell_1

    Cancel = True

    Exit Sub

  End If

  'the General Contractor entry

  whatCell_1 = "E6"

  If Trim(checkWS.Range(whatCell_1)) = "" Or _

   IsEmpty(checkWS.Range(whatCell_1)) Then

    MsgBox "Please provide entry into cell " & whatCell_1

    Cancel = True

    Exit Sub

  End If

  'the Safety Rep Company entry

  whatCell_1 = "E7"

  If Trim(checkWS.Range(whatCell_1)) = "" Or _

   IsEmpty(checkWS.Range(whatCell_1)) Then

    MsgBox "Please provide entry into cell " & whatCell_1

    Cancel = True

    Exit Sub

  End If

  'here I show how to check a contiguous range/list of cells

  'for the 4 entries in column O beginning at row 3.

  For RLC = 3 To 6 ' the rows involved

    whatCell_1 = "O" & CStr(RLC) ' combine "O" with the # to make an address

    If Trim(checkWS.Range(whatCell_1)) = "" Or _

     IsEmpty(checkWS.Range(whatCell_1)) Then

      MsgBox "Please provide entry into cell " & whatCell_1

      Cancel = True

      Exit Sub

    End If

  Next ' end of RLC loop

  'here I show how to check a contiguous range/list of cells

  'this time for the 3 Site Conditions entries

  For RLC = 10 To 12 ' the rows involved

    whatCell_1 = "K" & CStr(RLC) ' combine "K" with the # to make an address

    If Trim(checkWS.Range(whatCell_1)) = "" Or _

     IsEmpty(checkWS.Range(whatCell_1)) Then

      MsgBox "Please provide entry into cell " & whatCell_1

      Cancel = True

      Exit Sub

    End If

  Next ' end of RLC loop

End Sub

Answer 3

If you want to send me the workbook and have me add the code to it, feel free to do so.  Take the spaces out of the following and convert the UPPERCASE words to proper email characters and you'll have a good address to send it to:

help from AT jlathamsite DOT com

Answer 4

You've just put it in the wrong place.  Delete it from where you put it (in the worksheet's code module).

It needs to go into the 'ThisWorkbook' code module.

See the instructions here: http://www.contextures.com/xlvba01.html#Workbook

The topic title is Copy Excel VBA Code to a Workbook Module

The sequence that you check the cells in doesn't matter - you could check them "in order" like checking A3, then B9 then C5 or whatever, or you can just do them in any order.  Any that are not filled in will give an alert about it and halt the Save operation until it is corrected - this might result in several halts if more than just one of them is empty.

Naturally make sure you are saving the workbook as a Macro Enabled workbook, type .xlsm in order to preserve the code as part of the workbook.

Answer 5

I could not get this to work.

My A column has name, surname, mum, dad, aunt & hobby fields

My B column has ann, smith, pat, robert, mary & golf

I added your code example by entering the above data, right-clicking on the Sheet1 tab to get View Code. I pasted it, then saved as a Excel Macro-Enabled Workbook. I left cell B5 missing. It allowed me to save though.

I closed the doc and then went back into it. When I right-clicked on the tab to View Code again, there was nothing there.

Am I pasting your code in the right place ?? Am I saving the VBA Script and the sheet in the wrong order ?? Sorry, this is the first time for me to use VBA and I am obviously missing a saving convention somewhere.

Would it be possible for you to add my data as per above and add the code you suggested and then send me the excel worksheet as a whole ?? I have tried so hard to find an excel worksheet example which I can tweak rather than just the VBA window element.

I would be most most grateful for your help re this matter.

Ann