Sorry, I'm new to VBA. I have a spreadsheet that consists of columns with drop-down menus. I want to put in some mandatory fields (before close) to ensure these fields are completed. I want to give them as much info as to why there’s an error and where it is. I have a code, but it only works on what is entered in the first row of entry (row 3).
So if Row 3 says “New record”, it will require the mandatory field for New records to be completed, but if Row 4 says “New opportunity” it will still require the mandatory for New Record to be completed etc. It ignores what is entered in the rows below Row 3. I will need to put in a couple more mandatories for other fields in the spreadsheet once I get this one working. The code is
Many thanks in advance
So if Row 3 says “New record”, it will require the mandatory field for New records to be completed, but if Row 4 says “New opportunity” it will still require the mandatory for New Record to be completed etc. It ignores what is entered in the rows below Row 3. I will need to put in a couple more mandatories for other fields in the spreadsheet once I get this one working. The code is
VBA Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call sMacro1
Call sMacro2
Call sMacro3
End Sub
Private Sub sMacro1()
Dim dataWS As Worksheet
Dim ckRange As Range
Dim anyCell As Range
Dim currentRow As Long
Dim whatCol As String
Dim errMessage As String
Set dataWS = ThisWorkbook.Worksheets("CREATION OF NEW CLIENTS & OPPS")
Set ckRange = dataWS.Range("B4:" & _
dataWS.Range("B" & Rows.Count).End(xlUp).Address)
For Each anyCell In ckRange
If Range("B4").Value = "New Record" Then
currentRow = anyCell.Row
whatCol = "A"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Misssing your name, this is a mandatory field for the creation of a New Record "
GoTo ExitWithoutSaving
End If
whatCol = "C"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Record type, this is a mandatory field for the creation of a New Record "
GoTo ExitWithoutSaving
End If
whatCol = "E"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Record Name, this is a mandatory field for the creation of a New Record "
GoTo ExitWithoutSaving
End If
whatCol = "I"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Country details, this is a mandatory field for the creation of a New Record "
GoTo ExitWithoutSaving
End If
whatCol = "AB"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing CRUK Interest Department, this is a mandatory field for the creation of a New Record "
GoTo ExitWithoutSaving
End If
whatCol = "AC"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing CRUK Interest/Supporter Type, this is a mandatory field for the creation of a New Record "
GoTo ExitWithoutSaving
End If
whatCol = "AH"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Primary Canvasser, this is a mandatory field for the creation of a New Record "
GoTo ExitWithoutSaving
End If
whatCol = "BB"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Today's date, this is a mandatory field. "
GoTo ExitWithoutSaving
End If
End If
Next
Set dataWS = Nothing
Exit Sub
ExitWithoutSaving:
Cancel = True
With dataWS
.Activate
.Range(whatCol & currentRow).Activate
End With
MsgBox errMessage & " This information is required in cell " & whatCol & currentRow, vbCritical, "Required Entry"
Set dataWS = Nothing
End Sub
Private Sub sMacro2()
Dim dataWS As Worksheet
Dim ckRange As Range
Dim anyCell As Range
Dim currentRow As Long
Dim whatCol As String
Dim errMessage As String
Set dataWS = ThisWorkbook.Worksheets("CREATION OF NEW CLIENTS & OPPS")
Set ckRange = dataWS.Range("B4:" & _
dataWS.Range("B" & Rows.Count).End(xlUp).Address)
For Each anyCell In ckRange
If Range("B4").Value = "New Opportunity" Then
currentRow = anyCell.Row
whatCol = "A"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Misssing your name, this is a mandatory field for the creation of a New Opportunity "
GoTo ExitWithoutSaving
End If
whatCol = "C"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Record type, this is a mandatory field for the creation of a New Opportunity "
GoTo ExitWithoutSaving
End If
whatCol = "D"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing URN, this is a mandatory field for the creation of a New Opportunity "
GoTo ExitWithoutSaving
End If
whatCol = "E"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Record Name, this is a mandatory field for the creation of a New Opportunity "
GoTo ExitWithoutSaving
End If
whatCol = "AM"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Department, this is a mandatory field for the creation of a New Opportunity "
GoTo ExitWithoutSaving
End If
whatCol = "AN"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Product Code, this is a mandatory field for the creation of a New Opportunity. "
GoTo ExitWithoutSaving
End If
whatCol = "AO"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Funding Opportunity, this is a mandatory field for the creation of a New Opportunity "
GoTo ExitWithoutSaving
End If
whatCol = "AS"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Stage, this is a mandatory field for the creation of a New Opportunity "
GoTo ExitWithoutSaving
End If
whatCol = "AT"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Likelihood, this is a mandatory field for the creation of a New Opportunity "
GoTo ExitWithoutSaving
End If
whatCol = "BA"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Opportunity Canvasser , this is a mandatory field for the creation of a New Opportunity "
GoTo ExitWithoutSaving
End If
whatCol = "BB"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Today's date "
GoTo ExitWithoutSaving
End If
End If
Next
Set dataWS = Nothing
Exit Sub
ExitWithoutSaving:
Cancel = True
With dataWS
.Activate
.Range(whatCol & currentRow).Activate
End With
MsgBox errMessage & " This information is required in cell " & whatCol & currentRow, vbCritical, "Required Entry"
Set dataWS = Nothing
End Sub
Private Sub sMacro3()
Dim dataWS As Worksheet
Dim ckRange As Range
Dim anyCell As Range
Dim currentRow As Long
Dim whatCol As String
Dim errMessage As String
Set dataWS = ThisWorkbook.Worksheets("CREATION OF NEW CLIENTS & OPPS")
Set ckRange = dataWS.Range("B4:" & _
dataWS.Range("B" & Rows.Count).End(xlUp).Address)
For Each anyCell In ckRange
If Range("B4").Value = "New Record and Opportunity" Then
currentRow = anyCell.Row
whatCol = "A"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Misssing your name, this is a mandatory field for the creation of a New Record & Opportunity "
GoTo ExitWithoutSaving
End If
whatCol = "C"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Record type, this is a mandatory field for the creation of a New Record & Opportunity "
GoTo ExitWithoutSaving
End If
whatCol = "E"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Record Name , this is a mandatory field for the creation of a New Record & Opportunity "
GoTo ExitWithoutSaving
End If
whatCol = "I"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Country, this is a mandatory field for the creation of a New Record & Opportunity "
GoTo ExitWithoutSaving
End If
whatCol = "AB"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing CRUK Interest Department, this is a mandatory field for the creation of a New Record & Opportunity "
GoTo ExitWithoutSaving
End If
whatCol = "AC"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing CRUK Interest/Supporter Type, this is a mandatory field for the creation of a New Record & Opportunity "
GoTo ExitWithoutSaving
End If
whatCol = "AH"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Primary Canvasser, this is a mandatory field for the creation of a New Record & Opportunity "
GoTo ExitWithoutSaving
End If
whatCol = "AM"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Department, this is a mandatory field for the creation of a New Record & Opportunity "
GoTo ExitWithoutSaving
End If
whatCol = "AN"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Product Code, this is a mandatory field for the creation of a New Record & Opportunity "
GoTo ExitWithoutSaving
End If
whatCol = "AO"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Funding Opportunity, this is a mandatory field for the creation of a New Record & Opportunity "
GoTo ExitWithoutSaving
End If
whatCol = "AS"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Stage, this is a mandatory field for the creation of a New Record & Opportunity "
GoTo ExitWithoutSaving
End If
whatCol = "AT"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Likelihood, this is a mandatory field for the creation of a New Record & Opportunity "
GoTo ExitWithoutSaving
End If
whatCol = "BA"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Opportunity Canvasser, this is a mandatory field for the creation of a New Record & Opportunity "
GoTo ExitWithoutSaving
End If
whatCol = "BB"
If IsEmpty(dataWS.Range(whatCol & currentRow)) Then
errMessage = "Missing Today's date "
GoTo ExitWithoutSaving
End If
End If
Next
Set dataWS = Nothing
Exit Sub
ExitWithoutSaving:
Cancel = True
With dataWS
.Activate
.Range(whatCol & currentRow).Activate
End With
MsgBox errMessage & " This information is required in cell " & whatCol & currentRow, vbCritical, "Required Entry"
Set dataWS = Nothing
End SubMany thanks in advance
Last edited by a moderator:
