New to VBA - VBA Before Save & Before Email

Hi Everyone,

I hope someone is able to help me and apologies if i don't explain this very well but i'm in the process of creating a user interactive form on Excel. We used to have this form on a word document but as a few fields used to be left blank i'd like to make it so that the form cannot be submitted (i.e beforesave or beforeemail) unless the information is completely filled in.

Any field that has a red * is deemed to be mandatory and must be completed.

There are also 2 types of combobox on the form, 1 for Cost Centre & the other for GL. Is it possible to make the Cost Centre and GL mandatory for completion only if the rest of that row has cells filled in? So, ComoBox1 & ComboBox6 are only mandatory if cells B45 - F45 are filled?

Thanks in advance!

Hi giggles2005 and welcome to ExcelForum,

Notes:
a. Link ComboBoxes to Underyling cells
b. Description of Product MUST be Mandatory - otherwise how do you know what is being purchased.
c. Removed TextBoxes in Column E (VAT).
d. Option Explicit
e. Added check for all BLANK Data Lines.

It is highly recommended that you avoid 'ActiveX' Controls (ComboBoxes, TextBoxes, CommandButtons) and use 'Forms' Controls instead. 'ActiveX' does not play well with others, and can cause Controls to move or worse.

Try the following code which is included in the modified copy of your sample workbook (attached):

In the Code Module For Sheet 'PO Request Form':

Option Explicit

Private Sub CommandButton1_Click()

  Dim OutlookApp As Object
  Dim OutlookMail As Object
  
  Dim sErrorMessage As String
  
  'Verify that required Inputs are NOT BLANK
  'Display an Error Message and Exit if they are BLANK
  sErrorMessage = VerifyInputs()
  If Len(sErrorMessage) > 0 Then
    MsgBox sErrorMessage
    Exit Sub
  End If
  
  Set OutlookApp = CreateObject("Outlook.Application")
  Set OutlookMail = OutlookApp.CreateItem(0)
  
  With OutlookMail
    .To = "giggles2005-2006@hotmail.co.uk"
    .Subject = "PO Request"
    .Body = " Hi Team, please can you raise the attached?"
    .attachments.Add ActiveWorkbook.FullName
    .Display
End With

  Set OutlookMail = Nothing
  Set OutlookApp = Nothing

End Sub

In Ordinary Code Module ModVerifyInputs:

Option Explicit

Function VerifyInputs() As String
  'This returns an Error Message String if any of the required inputs are BLANK.
  '
  'The Null String is returned if there are no MISSING ITEMS

  Dim wb As Workbook
  Dim ws As Worksheet

  Dim i As Long
  Dim iArrayOfDataRowNumbers(1 To 5)
  Dim iColumnIndex As Long
  Dim iCountOfNonBlankMandatoryItemsThisRow As Long
  Dim iNumberOfMandatoryItemsPerRow As Long
  Dim iRow As Long
  Dim iRowIndex As Long
  
  Dim bComboBoxesRequired As Boolean
  Dim bHaveNonBlankDataEntry As Boolean
  
  Dim sArrayOfAdminCells(1 To 6) As String
  Dim sArrayOfMandatoryDataColumns(1 To 3) As String
  Dim sArrayOfSemiMandatoryDataColumns(1 To 2) As String
  Dim sBadListAdmin As String
  Dim sBadListData As String
  Dim sCellAddress As String
  Dim sColumn As String
  Dim sErrorMessage As String
  Dim sValue As String
  
  'Pseudo Constant
  sArrayOfAdminCells(1) = "C18"
  sArrayOfAdminCells(2) = "C21"
  sArrayOfAdminCells(3) = "C24"
  sArrayOfAdminCells(4) = "C31"
  sArrayOfAdminCells(5) = "C35"
  sArrayOfAdminCells(6) = "C39"
  
  sArrayOfMandatoryDataColumns(1) = "C"
  sArrayOfMandatoryDataColumns(2) = "D"
  sArrayOfMandatoryDataColumns(3) = "E"
  sArrayOfSemiMandatoryDataColumns(1) = "G"
  sArrayOfSemiMandatoryDataColumns(2) = "H"
  
  iArrayOfDataRowNumbers(1) = 45
  iArrayOfDataRowNumbers(2) = 47
  iArrayOfDataRowNumbers(3) = 49
  iArrayOfDataRowNumbers(4) = 51
  iArrayOfDataRowNumbers(5) = 53
  
  
  'Create Worksheet Object
  Set wb = ThisWorkbook    'The file that contains this code
  Set ws = wb.Sheets("PO Request Form")
  
  
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Verify Admin Data
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  For i = LBound(sArrayOfAdminCells) To UBound(sArrayOfAdminCells)
  
    'Get the Next Cell Address
    'Get the Next Value (remove leading/trailing Spaces)
    sCellAddress = sArrayOfAdminCells(i)
    sValue = Trim(ws.Range(sCellAddress).Value)
    'Debug.Print i, sCellAddress, Len(sValue)  'Output to Immediate Window (Ctrl G) in the debugger
    
    'Add to the 'Bad List' if the Value is BLANK
    If Len(sValue) = 0 Then
      If Len(sBadListAdmin) = 0 Then
        sBadListAdmin = "The following Administrative cells are NOT allowed to be BLANK:" & vbCrLf & "   " & sCellAddress
      Else
        sBadListAdmin = sBadListAdmin & "  " & sCellAddress
      End If
    End If
    
  Next i
  
  
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Verify Data
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  
  'Get the Number of 'Mandatory Items' Per Row
  iNumberOfMandatoryItemsPerRow = UBound(sArrayOfMandatoryDataColumns) - LBound(sArrayOfMandatoryDataColumns) + 1
  
  For iRowIndex = LBound(iArrayOfDataRowNumbers) To UBound(iArrayOfDataRowNumbers)
  
    'Get the Row Number
    iRow = iArrayOfDataRowNumbers(iRowIndex)
  
    'Initialize Variables
    bComboBoxesRequired = False
    iCountOfNonBlankMandatoryItemsThisRow = 0
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Get the Count of NonBlank Mandatory Items on this Row
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    For iColumnIndex = LBound(sArrayOfMandatoryDataColumns) To UBound(sArrayOfMandatoryDataColumns)
  
      'Get the Next Cell Address by concatenating the Column Letter and Row Number
      'Get the Next Value (remove leading/trailing Spaces)
      sColumn = sArrayOfMandatoryDataColumns(iColumnIndex)
      sCellAddress = sColumn & iRow
      sValue = Trim(ws.Range(sCellAddress).Value)
    
      'Increment the Count of Non-Blank Mandatory Items on this Row if the Value is NOT BLANK
      If Len(sValue) > 0 Then
        bHaveNonBlankDataEntry = True
        iCountOfNonBlankMandatoryItemsThisRow = iCountOfNonBlankMandatoryItemsThisRow + 1
      End If
    
    Next iColumnIndex
  
  
  
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Process this Column only if there is at least one NOT BLANK 'Mandatory Item'
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If iCountOfNonBlankMandatoryItemsThisRow > 0 Then
    
      For iColumnIndex = LBound(sArrayOfMandatoryDataColumns) To UBound(sArrayOfMandatoryDataColumns)
  
        'Get the Next Cell Address by concatenating the Column Letter and Row Number
        'Get the Next Value (remove leading/trailing Spaces)
        sColumn = sArrayOfMandatoryDataColumns(iColumnIndex)
        sCellAddress = sColumn & iRow
        sValue = Trim(ws.Range(sCellAddress).Value)
    
        'Add to the 'Bad List' if the Value is BLANK
        If Len(sValue) = 0 Then
          If Len(sBadListData) = 0 Then
            sBadListData = "The following Data cells are NOT allowed to be BLANK:" & vbCrLf & "   " & sCellAddress
          Else
            sBadListData = sBadListData & "  " & sCellAddress
          End If
        End If
    
      Next iColumnIndex
    
    End If
    
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Process the ComboBox Rows only if all the 'Mandatory Items' on this Row Have Data
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If iCountOfNonBlankMandatoryItemsThisRow = iNumberOfMandatoryItemsPerRow Then
    
      For iColumnIndex = LBound(sArrayOfSemiMandatoryDataColumns) To UBound(sArrayOfSemiMandatoryDataColumns)
  
        'Get the Next Cell Address by concatenating the Column Letter and Row Number
        'Get the Next Value (remove leading/trailing Spaces)
        sColumn = sArrayOfSemiMandatoryDataColumns(iColumnIndex)
        sCellAddress = sColumn & iRow
        sValue = Trim(ws.Range(sCellAddress).Value)
    
        'Add to the 'Bad List' if the Value is BLANK
        If Len(sValue) = 0 Then
          If Len(sBadListData) = 0 Then
            sBadListData = "The following Data cells are NOT allowed to be BLANK:" & vbCrLf & "   " & sCellAddress
          Else
            sBadListData = sBadListData & "  " & sCellAddress
          End If
        End If
    
      Next iColumnIndex
    
    End If
        
  Next iRowIndex
  
  
  
  'Create Error Text if there are Bad Inputs or No Inputs
  If Len(sBadListAdmin) > 0 Or Len(sBadListData) > 0 Then
    sErrorMessage = "Email Request is NOT ALLOWED to be sent."
  End If
  
  If Len(sBadListAdmin) > 0 Then
    sErrorMessage = sErrorMessage & vbCrLf & vbCrLf & _
                    sBadListAdmin
  End If
  
  If Len(sBadListData) > 0 Then
    sErrorMessage = sErrorMessage & vbCrLf & vbCrLf & _
                    sBadListData
  End If
  
  If Len(sErrorMessage) = 0 And bHaveNonBlankDataEntry = False Then
    sErrorMessage = "Email Request is NOT ALLOWED to be sent." & vbCrLf & _
                    "All Data Entry Cells are BLANK."
  End If
  
  'Set the Return Value
  VerifyInputs = sErrorMessage

 'Clear Object Pointers
 Set wb = Nothing
 Set ws = Nothing

End Function

To prevent typos from ruining days and weeks of work 'Option Explicit' is NEEDED at the top of each code module. This prevents errors caused by missspellings and FORCES every variable to be DECLARED (e.g. Dim i as Integer). http://www.cpearson.com/excel/DeclaringVariables.aspx

Lewis

Hi Lewis,

Many thanks for your help with this. Its just what I needed!

Just a quick question though - once all the fields have been completed correctly and emailed through, when I click to download the completed form, none of the information that was inputted is pulling through? How do I correct this?

Any help you could give would be incredible.

Thank you

Hi,

The workbook was blank because the file was never saved. I thought you were going to do that manually. You had this code in the file (which I did not touch) that prevented the file from being saved unless VBA was disabled (Application.EnableEvents = False).

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

'If the six specified cells do not contain data, then display a message box with 'and cancel the attempt to save.
'"If worksheetfunction.CountA(Worksheets("Sheet1").Range(C40,D40,E40,F40,G40,H40") ) < 6 Then MsbBox "Worrkbook will not be saved unless" & vbCrlf & _"
'"All required fields have been filled in"
Cancel = True

End Sub
'Exit If

I updated the file, to change the code so the file can be saved when all the fields are filled in. Changes in red:
In the ThisWorkbook Code Module:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  
  'Verify that required Inputs are NOT BLANK
  'Display an Error Message and Exit if they are BLANK
  sErrorMessage = VerifyInputs()
  If Len(sErrorMessage) > 0 Then
    Cancel = True
    MsgBox sErrorMessage
    Exit Sub
  End If
  
End Sub

In the Sheet PO Request Form Code Module:

Option Explicit

Private Sub CommandButton1_Click()

  Dim OutlookApp As Object
  Dim OutlookMail As Object
  
  Dim sErrorMessage As String
  
  'Verify that required Inputs are NOT BLANK
  'Display an Error Message and Exit if they are BLANK
  sErrorMessage = VerifyInputs()
  If Len(sErrorMessage) > 0 Then
    MsgBox sErrorMessage
    Exit Sub
  End If
  
  'Save this file
  ActiveWorkbook.Save
  
  Set OutlookApp = CreateObject("Outlook.Application")
  Set OutlookMail = OutlookApp.CreateItem(0)
  
  With OutlookMail
    .To = "giggles2005-2006@hotmail.co.uk"
    .Subject = "PO Request"
    .Body = " Hi Team, please can you raise the attached?"
    .attachments.Add ActiveWorkbook.FullName
    .Display
End With

  Set OutlookMail = Nothing
  Set OutlookApp = Nothing

End Sub

The Ordinary Code module that verified inputs had no change.

Lewis