Solved: check in wb if is filled all what is needed

[danovkos]

Hi all,
pls. how can hi do following?

I have table in sheet KRIZ, and i want in this table in this sheet check, if user filled any value in column B. If yes, is neccessary to fill something to column F, G and J (in all this columns). If will one of this column in this row blank, and user will want to quit or save file, it appears msgbox „Neccessary to fill all fields“ and doesnt quit and doesnt save.

I want to have filled all neccesary data in table, if is there any new name in column B.

edit:
i have there a header, so is it possible exepct first 3 rows?

Pls. how can i do that?
thx a lot

[mbarron]

Right click on a tab and choose View code.
double click on ThisBorkbook for the current book in the Project Explorer
Paste the following in the code window:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim lB As Long, i As Long, KRIZ As Worksheet
Set KRIZ = Worksheets("KRIZ")
lB = KRIZ.Cells(Rows.Count, 2).End(xlUp).Row
For i = lB To 3 Step -1
If KRIZ.Cells(i, 2) <> "" Then
If KRIZ.Cells(i, 6) = "" Or KRIZ.Cells(i, 7) = "" Or KRIZ.Cells(i, 10) = "" Then
MsgBox "Please fill completely"
Cancel = True
Application.DisplayAlerts = False
Exit Sub
End If
End If
Next
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim lB As Long, i As Long, KRIZ As Worksheet
Set KRIZ = Worksheets("KRIZ")
lB = KRIZ.Cells(Rows.Count, 2).End(xlUp).Row
For i = lB To 3 Step -1
If KRIZ.Cells(i, 2) <> "" Then
If KRIZ.Cells(i, 6) = "" Or KRIZ.Cells(i, 7) = "" Or KRIZ.Cells(i, 10) = "" Then
MsgBox "Please fill completely"
Cancel = True
Application.DisplayAlerts = False
Exit Sub
End If
End If
Next
End Sub

[RolfJ]

Here is one way to accomplish this. Place the following code into the ThisWorkbook VBA module of your workbook and give it a try:


Const USERINPUT_SHEETNAME As String = "KRIZ"
Const DATA_ENTRY_COL As String = "B"
Const COL1 As String = "F"
Const COL2 As String = "G"
Const COL3 As String = "J"

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Not UserInputIsComplete Then
MsgBox "Necessary to fill all fields.", vbCritical, "CAN'T SAVE THE WORKBOOK YET."
Cancel = True
End If
End Sub

Function UserInputIsComplete() As Boolean
Dim sh As Worksheet
Set sh = Worksheets(USERINPUT_SHEETNAME)
Dim db As Range
Set db = Range(sh.Range("A1"), sh.Range("B" & sh.Rows.Count).End(xlUp))
Dim rCell As Range
For Each rCell In db.Columns(DATA_ENTRY_COL).Cells
If rCell.Value <> vbEmpty Then
If db.Cells(1, COL1) = vbEmpty Or db.Cells(1, COL2) = vbEmpty Or db.Cells(1, COL3) = vbEmpty Then
UserInputIsComplete = False
Exit Function
End If
End If
Next rCell
UserInputIsComplete = True
End Function

[danovkos]

to RolfJ:
thx for your help. I dont know why, but your code doesnt works for me. It always return msbbox "fill all fields". But i change, add nothing to my wb and all fields are filled. Nevermind thx for it.

to mbarron (http://www.vbaexpress.com/forum/member.php?u=266):
your code works perfect. Exactly as i wish. thank you very much. vbmenu_register("postmenu_203334", true);