PDA

View Full Version : [SOLVED] Asking user to please enter all mandatory filed



rajesh nag
12-05-2007, 03:01 AM
Hi

Marketing Plan Name
Related Initiatives
Region
Start Period
End Period
Business Unit

I have above coulumns in my Excel sheet i would like make the sheet without entreing data into these filed should show an error while saving the file

"please enter all mandatory filed"

without user form

Can any one help on this

Regards
Rajesh

paulked
12-05-2007, 02:22 PM
Hi

Marketing Plan Name
Related Initiatives
Region
Start Period
End Period
Business Unit



If these are in column A and your required fields are in column B then put this in the ThisWorbook module.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i
For i = 1 To 6
If Range("B" & i) = "" Then
MsgBox "Please enter all mandatory fields!"
Cancel = True
End If
Next
End Sub

rajesh nag
12-05-2007, 07:46 PM
Hi these columns are in A:F source

A:-Marketing Plan Name
B:-Related Initiatives
C:-Region
D:-Start Period
E:-End Period
F:-Business Unit

paulked
12-06-2007, 08:21 AM
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Range("a1") = "" Or Range("b1") = "" Or Range("c1") = "" Or _
Range("d1") = "" Or Range("e1") = "" Or Range("f1") = "" Then
MsgBox "Please enter all mandatory fields!"
Cancel = True
End If
End Sub

rajesh nag
12-07-2007, 01:27 AM
Hi


I have attached two files one with user form another without


A:-Marketing Plan Name
B:-Related Initiatives
C:-Region
D:-Start Period
E:-End Period
F:-Business Unit

I have above coulumns in my Excel sheet i would like make the sheet without entreing data into these filed should show an error while saving the file

"please enter all mandatory filed"

without user form, i want the same machanism showing error "please enter all mandatory filed" to test file as in mktg plan

Can any one help on this

Rajesh

rajesh nag
12-07-2007, 01:29 AM
http://vbaexpress.com/forum/showthread.php?p=125774

i have attached files in this can u pls help mr.Paulked

Simon Lloyd
12-07-2007, 03:43 AM
I haven't looked at your workbooks, however you can use this in the Thisworkbook module (get there by pressing Alt+F11, right click thisworkbook view code then paste in).


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim MyCell As Range
Dim Rng As Range
Set Rng = Sheets("Sheet1").Range("A1:Z100") 'set your range
For Each MyCell In Rng 'check each cell in that range
If IsEmpty(MyCell) Then 'if it is empty
MsgBox "Empty Cells exist" 'actions To Do If True
MyCell.Select 'goto the offending cell
Exit Sub
End If
Next
End Sub

lucas
12-07-2007, 08:35 AM
Threads merged

rbrhodes
12-08-2007, 10:10 PM
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

Krishna Kumar
12-10-2007, 04:12 AM
Hi,


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim r As Long, a, i As Long
r = Sheets("Sheet1").Range("a1").CurrentRegion.Rows.Count
a = Range(Cells(r, 1), Cells(r, 6))
For i = 1 To UBound(a, 2)
If Len(Application.Trim(a(1, i))) = 0 Then
MsgBox "Please enter all mandatory fields!"
Sheets("Sheet1").Cells(r, i).Activate
Cancel = True
End If
Next
End Sub

rajesh nag
12-10-2007, 07:43 PM
Hi

The codes are not working for me, I was able to close the file with out any data in all other columns, In line two where the values present in column a and b still there is no error while saving the file or closing the file

I have created my own module

Module 2

After running the module it is showing error

i dont want my user to run the module it should be hided

If i use private it's not working

I have one more problem in my module it is showing errro even all the columns are it shoul show error if any one of the column contains any value.

Please help me on this

Regards
Rajesh

Krishna Kumar
12-11-2007, 02:33 AM
Hi Rajesh,

Place the code in ThisWorkbook module.

rajesh nag
12-11-2007, 03:41 AM
I have posted in work book module still its not working please down load the attachment and could u pls help me trying in it

Krishna Kumar
12-11-2007, 03:48 AM
Hi,

See the attachment.

HTH

rajesh nag
12-11-2007, 10:19 AM
Thanks a lot for spending your time for me

but i have a trouble it is working only for last line

if any values in previous rows is null it is not showing any error

could you please help me on this

Regards

Rajesh

Krishna Kumar
12-12-2007, 01:25 AM
Replace the old code with the following


Public Flg As Boolean
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call Sample
If Flg Then Cancel = True
End Sub
Private Sub Sample()
Dim r As Long, a, i As Long, ws As Worksheet
Set ws = Sheets("Sheet1")
a = ws.Range("a1").CurrentRegion
Flg = False
For i = 1 To UBound(a, 2)
With Application
If .CountA(.Index(a, 0, i)) <> UBound(a, 1) Then
Flg = True
MsgBox "Please enter all mandatory fields!"
ws.Activate
Exit Sub
End If
End With
Next
End Sub

rajesh nag
12-12-2007, 01:36 AM
thanks a lot for helping me to soleve my issue