Asking user to please enter all mandatory filed

[rbrhodes]

Hi rajesh,

I'm sure you want the code to do more but here's a solution that does what you asked for.

- It checks Cols A to F for the largest number of rows
- Then checks each cell in those Columns
- If it finds a blank in any of the cells it displays a message and stops (it cancels the save)

to use it:

1) Open the VBE (Alt+F11)

2) Double click on "This Workbook" module and paste the code in

3) Close the VBE

4) Edit and save the file

Option Explicit
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim A As Long
Dim B As Long
Dim C As Long
Dim D As Long
Dim E As Long
Dim F As Long
Dim xRow As Long
Dim xCol As Long
Dim lastrow As Long
' Get last row of each column
A = Range("A65536").End(xlUp).Row
B = Range("B65536").End(xlUp).Row
C = Range("C65536").End(xlUp).Row
D = Range("D65536").End(xlUp).Row
E = Range("E65536").End(xlUp).Row
F = Range("F65536").End(xlUp).Row
' Check which is largest
If A = B And A = C And A = D And A = E And A = F Then
' all equal - use Col A
lastrow = A
ElseIf A >= B And A >= C And A >= D And A >= E And A >= F Then
' is A (typ)
lastrow = A
ElseIf B >= A And B >= C And B >= D And B >= E And B >= F Then
lastrow = B
ElseIf C >= A And C >= B And C >= D And C >= E And C >= F Then
lastrow = C
ElseIf D >= A And D >= B And D >= C And D >= E And D >= F Then
lastrow = D
ElseIf E >= A And E >= B And E >= C And E >= D And E >= F Then
lastrow = E
ElseIf F >= A And F >= B And F >= C And F >= D And F >= E Then
lastrow = F
End If
'check all cells
' All rows
For xRow = 2 To lastrow
' All Cols
For xCol = 1 To 6
'If blank
If Cells(xRow, xCol) = "" Then
' Inform user
MsgBox ("Mandatory field!")
' Select blank cell
Cells(xRow, xCol).Select
' Cancel save
Cancel = True
'bail
Exit Sub
End If
Next xCol
Next xRow
End Sub

This one might be faster as it uses the 'Find' command instead of checking every cell:

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim A As Long
Dim B As Long
Dim C As Long
Dim D As Long
Dim E As Long
Dim F As Long
Dim lastrow As Long
    ' Get last row of each column
    A = Range("A65536").End(xlUp).Row
    B = Range("B65536").End(xlUp).Row
    C = Range("C65536").End(xlUp).Row
    D = Range("D65536").End(xlUp).Row
    E = Range("E65536").End(xlUp).Row
    F = Range("F65536").End(xlUp).Row
    ' Check which is largest
    If A = B And A = C And A = D And A = E And A = F Then
        ' all equal - use Col A
        lastrow = A
    ElseIf A >= B And A >= C And A >= D And A >= E And A >= F Then
        ' is A (typ)
        lastrow = A
    ElseIf B >= A And B >= C And B >= D And B >= E And B >= F Then
        lastrow = B
    ElseIf C >= A And C >= B And C >= D And C >= E And C >= F Then
        lastrow = C
    ElseIf D >= A And D >= B And D >= C And D >= E And D >= F Then
        lastrow = D
    ElseIf E >= A And E >= B And E >= C And E >= D And E >= F Then
        lastrow = E
    ElseIf F >= A And F >= B And F >= C And F >= D And F >= E Then
        lastrow = F
    End If
'allow not found
    On Error GoTo endo
    'find blank cell
    Range(Cells(2, 1).Address, Cells(lastrow, 6).Address).Find(What:="", After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
' Inform user
MsgBox ("Mandatory field!")
    ' Cancel save
    Cancel = True
endo:
    On Error GoTo 0
End Sub