Make mandatory cells before closing (saving) for multiple workbooks

[mradomir]

I have to make a few hundred forms to various e-mail addresses, but I would like to prevent empty answers. I used "Data Validation" option (unchecked "ignore blank"), but you must enter the cell to activate this, if you don't enter you will not trigger validation.
I tried to find the VBA code and succeeded:
"
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim ws As Worksheet
Set ws = Worksheets("A")

If ws.Application.WorksheetFunction.CountBlank(ws.Range("G5")) > 0 Then

MsgBox ("some text referring to enter in cell G5 in sheet A")

Cancel = True

End If

If ws.Application.WorksheetFunction.CountBlank(ws.Range("Q12:Q12")) > 0 And ws.Application.WorksheetFunction.CountBlank(ws.Range("T12:T12")) > 0 Then

MsgBox ("some text referring to enter in cell Q12 and T12 in sheet A")


Cancel = True

End If

Dim ws1 As Worksheet
Set ws1 = Worksheets("Dio B")

If ws1.Application.WorksheetFunction.CountBlank(ws.Range("Q12:Q12")) > 0 And ws1.Application.WorksheetFunction.CountBlank(ws.Range("T12:T12")) > 0 Then

MsgBox ("some text referring to enter in cell Q12 and T12 in sheet B")
Cancel = True
End If

End Sub

"

But it is a Private Sub (Cancel As Boolean) and I can't spread it to all forms. I found code to do that, but it is not functioning if it is not "Private Sub(Cancel As Boolean)":

Sub LoopThroughFiles()
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Do While xFileName <> ""
With Workbooks.Open(xFdItem & xFileName)

Dim ws As Worksheet
Set ws = Worksheets("Dio A")

If ws.Application.WorksheetFunction.CountBlank(ws.Range("G5")) > 0 Then

MsgBox ("some text referring to enter in cell G5 in sheet A")

Cancel = True

End If

If ws.Application.WorksheetFunction.CountBlank(ws.Range("Q12:Q12")) > 0 And ws.Application.WorksheetFunction.CountBlank(ws.Range("T12:T12")) > 0 Then

MsgBox ("some text referring to enter in cell Q12 and T12 in sheet A")


Cancel = True

End If

Dim ws1 As Worksheet
Set ws1 = Worksheets("Dio B")

If ws1.Application.WorksheetFunction.CountBlank(ws.Range("Q12:Q12")) > 0 And ws1.Application.WorksheetFunction.CountBlank(ws.Range("T12:T12")) > 0 Then

MsgBox ("some text referring to enter in cell Q12 and T12 in sheet B")
Cancel = True
End If

End With
xFileName = Dir
Loop
End If
End Sub

I tried some other codes, but always the same: if it is not Private Sub (Cancel As Boolean) it is not functioning. Please help.

 

[Micron]

You cannot simply put Cancel = True in code wherever you like. It has to be a parameter of the event, as in the workbook close event. Not sure of your goal but I might do it by using such an event (close, beforesave or any other suitable event) but pass the testing to a function (not a sub). Put the function in a standard module and you should be able to run it from any sheet. Something like

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'dim stuff

If LoopThroughFiles = False Then Cancel = True

End Sub

Function LoopThroughFiles()As Boolean
'Dim stuff

'do stuff
'do logical test(s) like this one:
If ws.Application.WorksheetFunction.CountBlank(ws.Range("G5")) > 0 Then 
   LoopThroughFiles = False
   'maybe Exit Function - I don't know
End If

End Function

Please post code between code tags (use vba button on posting toolbar as I did) to maintain indentation and readability. I usually won't bother to read code like that 'cause I'm old and cantankerous but I've just had my coffee fix.

 

[mradomir]

Thank you, and thank to coffee fix
I will try to explain:
I have to make a few hundred forms and send them to various e-mail addresses, and I made a code for that and everything is fine.
But when I receive fulfilled forms there is a bunch of empty (mandatory) cells, totally blank, without even zeros. I tried to prevent that using Data Validation and there is possible to explain in detail every mandatory field, uncheck "ignore blank", and put some warning to fulfill the cell, but if you do not enter the cell nothing happens, and you can close and/or save the document and send it back with a bunch of blanks. I tried to find a solution and I thought I found it but it is not functioning.

I found this code which does something inside every Excel sheet in a specific folder:

Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                'your code here
            End With
            xFileName = Dir
        Loop
    End If
End Sub

and when I put:

.Worksheets(1).Range("A1").Value = "Hello World!"

in "'your code here" it is functioning,

but if I put code that will not allow close (or save) if all mandatory cells are completed:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim ws As Worksheet
Set ws = Worksheets("A")

If ws.Application.WorksheetFunction.CountBlank(ws.Range("G5")) > 0 Then

MsgBox ("some text referring to enter in cell G5 in sheet A")

Cancel = True

End If

If ws.Application.WorksheetFunction.CountBlank(ws.Range("Q12:Q12")) > 0 And ws.Application.WorksheetFunction.CountBlank(ws.Range("T12:T12")) > 0 Then

MsgBox ("some text referring to enter in cell Q12 and T12 in sheet A")


Cancel = True

End If

Dim ws1 As Worksheet
Set ws1 = Worksheets("Dio B")

If ws1.Application.WorksheetFunction.CountBlank(ws.Range("Q12:Q12")) > 0 And ws1.Application.WorksheetFunction.CountBlank(ws.Range("T12:T12")) > 0 Then

MsgBox ("some text referring to enter in cell Q12 and T12 in sheet B")
Cancel = True
End If

End Sub

or like this:

Sub LoopThroughFiles()
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Do While xFileName <> ""
With Workbooks.Open(xFdItem & xFileName)

Dim ws As Worksheet
Set ws = Worksheets("Dio A")

If ws.Application.WorksheetFunction.CountBlank(ws.Range("G5")) > 0 Then

MsgBox ("some text referring to enter in cell G5 in sheet A")

Cancel = True

End If

If ws.Application.WorksheetFunction.CountBlank(ws.Range("Q12:Q12")) > 0 And ws.Application.WorksheetFunction.CountBlank(ws.Range("T12:T12")) > 0 Then

MsgBox ("some text referring to enter in cell Q12 and T12 in sheet A")


Cancel = True

End If

Dim ws1 As Worksheet
Set ws1 = Worksheets("Dio B")

If ws1.Application.WorksheetFunction.CountBlank(ws.Range("Q12:Q12")) > 0 And ws1.Application.WorksheetFunction.CountBlank(ws.Range("T12:T12")) > 0 Then

MsgBox ("some text referring to enter in cell Q12 and T12 in sheet B")
Cancel = True
End If

End With
xFileName = Dir
Loop
End If
End Sub

everything passed without errors, but I can close (and save) the document even if the cell is empty.

Now, I figured out some other problem: Accidentally, I deleted everything from that (G5) cell and then run this macro, and there was the message: "some text referring to enter in cell G5 in sheet A", so I figured that all my logic is vice versa: I wanted to put the macro in every document before it is fulfilled (to forbid closing/saving with blank cells), but I got macro which checking if all documents fulfilled, before sending them via e-mail.

I hope you understand what I want, and you can help me to get it.

Best regards,
Radomir

 

[Micron]

I don't know what else to tell you. Did you follow my instructions? I have this in the module for the workbook >>>

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If LoopThroughFiles = False Then Cancel = True
End Sub

I have this in a standard module >>>

Function LoopThroughFiles() As Boolean
If IsEmpty(Sheets("sheet3").Range("A1")) Then
     LoopThroughFiles = False
End If
End Function

Sheet3 cell A1 has no value. The result is that I cannot close the workbook.
If your user has the wb open and is entering data, then I don't see the point of looping over a bunch of workbooks in a folder. Don't you just need to check the active workbook for empty cells as I have shown?

 

[mradomir]

I am not sure if you understand me well. I have to make multiple workbooks (same forms) with empty cells and send them to (multiple) respondents. But I want to prevent empty cells in returned workbooks (forms) because I need to know that no cell is skipped. If somebody put 0 I assume that he/she wrote the question and made an answer, but if it is blank (empty) I assume that it is maybe skipped. I protect other (informative cells) and only necessary cells are editable. After I received fulfilled forms, I import them into Excel base and I can use them. So I don't need to forbid myself to close the specific documents, but to the respondent who will receive it and have an obligation to fulfill it.

 

[Micron]

Pretty sure that I understood. I gave you code lines that could prevent a wb from closing if data was missing, so when the user omits a required entry, that's what will happen. However I don't think I considered that you would also be affected by that. To avoid that issue, you could test for the Environ("username") property for you or whoever needs to be able to close with missing values in the sheets. To discover your username type in the immediate window: ?Environ("username") and press enter at the end of that line.

Say that the returned value for you is "mrad". Then use that value in the code as

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Environ("username") <> "mrad" Then
   If LoopThroughFiles = False Then Cancel = True
End If

End Sub

Anyone who's username is not in the code will be able to close the wb with missing data. What you need to do is make sure the workbook close and the function in the standard module is in every workbook that will be sent out.
Does that help?

 

[mradomir]

Maybe, now, I didn't understand well:
When I want to apply this Private Sub Workbook_BeforeClose(Cancel As Boolean) (with Environ and my user name) on all my workbooks (forms) I made in my folder for sending, I put it in a regular module like this:

Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                Function LoopThroughFiles1() As Boolean
                    If IsEmpty(Sheets("Dio A").Range("G5")) Then
                        LoopThroughFiles = False
                    End If
                End Function
            End With
            xFileName = Dir
        Loop
    End If
End Sub

I get an error:

I am quite a beginner in VBA so I have some strange questions, maybe, but I really would like to figure up how it functions, so please help.

Best regards,
Radomir
p.s. "username" is my Windows User name shown on "sign in" screen (in my case Name Surname: "RADOMIR I...A") or some other small caps text ("C...H\d...f")

or something directly from Excel?

 

[Micron]

You don't put Function / End Function inside any other procedure (macro). You can simply call the function by using a logical test ( If ) as I showed you:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'dim stuff
If LoopThroughFiles = False Then Cancel = True
End Sub
What I gave you was for checking one file that is open by a user and if the cells you specify in the code (I only specified one - A1). The idea of looping over files is another wrinkle that you have now introduced. What you have posted won't loop anyway because you specify SelectedItems(1). Why would you want to loop over files in a folder? It does not fit your originally stated requirement.

If you don't solve this by Sunday, I may not be able to follow up for 2 weeks as I'm going away.

 

[mradomir]

I saw that we misunderstand, but I am a beginner at this and maybe I didn't explain well.
You can see the explanation in my first and second posts, but I will try to reexplain:
- from my first post: "I have to make a few hundred forms to various e-mail addresses, but I would like to prevent empty answers. I used "Data Validation" option (unchecked "ignore blank"), but you must enter the cell to activate this, if you don't enter you will not trigger validation.I tried to find the VBA code and succeeded:..." but I succeeded only to find code with a Private subwhich can do it only in one form or workbook (private sub in ThisWorkbook). (from my first post): "

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim ws As Worksheet
Set ws = Worksheets("A")

If ws.Application.WorksheetFunction.CountBlank(ws.Range("G5")) > 0 Then

MsgBox ("some text referring to enter in cell G5 in sheet A")

Cancel = True

End If

If ws.Application.WorksheetFunction.CountBlank(ws.Range("Q12:Q12")) > 0 And ws.Application.WorksheetFunction.CountBlank(ws.Range("T12:T12")) > 0 Then

MsgBox ("some text referring to enter in cell Q12 and T12 in sheet A")


Cancel = True

End If

Dim ws1 As Worksheet
Set ws1 = Worksheets("Dio B")

If ws1.Application.WorksheetFunction.CountBlank(ws.Range("Q12:Q12")) > 0 And ws1.Application.WorksheetFunction.CountBlank(ws.Range("T12:T12")) > 0 Then

MsgBox ("some text referring to enter in cell Q12 and T12 in sheet B")
Cancel = True
End If

End Sub

"


I found another code that will allow me to spread this first code (Private sub code) in all forms in a folder. This second, which will go through all files in a folder and do something (put Hello World in some cell):
from my second post: "

Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                'your code here
            End With
            xFileName = Dir
        Loop
    End If
End Sub

and when I put:

.Worksheets(1).Range("A1").Value = "Hello World!"

in "'your code here" it is functioning,"

but if I want, using the second code, to spread the first (Private Sub) code through all my forms in the folder, like this: (from my first and second post):
"

Sub LoopThroughFiles()
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Do While xFileName <> ""
With Workbooks.Open(xFdItem & xFileName)

Dim ws As Worksheet
Set ws = Worksheets("Dio A")

If ws.Application.WorksheetFunction.CountBlank(ws.Range("G5")) > 0 Then

MsgBox ("some text referring to enter in cell G5 in sheet A")

Cancel = True

End If

If ws.Application.WorksheetFunction.CountBlank(ws.Range("Q12:Q12")) > 0 And ws.Application.WorksheetFunction.CountBlank(ws.Range("T12:T12")) > 0 Then

MsgBox ("some text referring to enter in cell Q12 and T12 in sheet A")


Cancel = True

End If

Dim ws1 As Worksheet
Set ws1 = Worksheets("Dio B")

If ws1.Application.WorksheetFunction.CountBlank(ws.Range("Q12:Q12")) > 0 And ws1.Application.WorksheetFunction.CountBlank(ws.Range("T12:T12")) > 0 Then

MsgBox ("some text referring to enter in cell Q12 and T12 in sheet B")
Cancel = True
End If

End With
xFileName = Dir
Loop
End If
End Sub

"
Everything passed without errors, but not functioning: When I enter any form (workbook) I can close it even if cells G5, Q12, and T12 in sheet "Dio A" and cells Q12 and T12 in "Dio B" are empty, so I conclude that my respondents will send me back documents with empty cells, which preventing was my first and only idea (from all posts), not now introduced one.

Sorry if I wasn't clear enough, and I will repeat my basic idea: The purpose for which I trying to find a code is to prevent any respondent (from a few hundred of them) could return to me the workbook (fulfilled form) with empty mandatory cells (in this case cells G5, Q12, and T12 in sheet "Dio A" and cells Q12 and T12 in "Dio B").

From my third post: "I protect other (informative cells) and only necessary cells are editable. After I received fulfilled forms, I import them into Excel base and I can use them. So I don't need to forbid myself to close the specific documents, but to the respondent who will receive it and have an obligation to fulfill it."

I hope that I, now, give a better explanation. Maybe all confusion begins from my uncoded VBA code from the first post, but, now I hope it is more clear.

Best regards,
Radomir

 

[mradomir]

Nobody knows???