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