hobbiton73
03-09-2013, 08:23 AM
Hi, I wonder whether someone may be able to help me please.
Using a solution I found here http://www.ozgrid.com/forum/showthread.php?t=57929 I've put together the following script which prevents users from saving a file if key cells are empty.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim rFound As Range
Dim strFind As String
Dim lLoop As Long
On Error Resume Next
With Sheets("Input")
For lLoop = 1 To 9
strFind = Choose(lLoop, "--Select--", "Enter your FTE", "Enter the Project Code", "Enter the name of the Project", _
"Enter the Work Package description", "Enter the name of the Enhancement(s)", "Enter the Work Package End Date", _
"Enter the name of your Work Manager", "Enter the name of your Line Manager")
Set rFound = .Range("B7:S400").Find(What:=strFind, After:=.Range("B7"), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
On Error GoTo 0
If Not rFound Is Nothing Then
If IsEmpty(rFound(1, 2)) Then
MsgBox "I'm sorry, your record(s) contain incomplete fields and the file cannot be saved. Please correct these and try again"
Cancel = True
End If
End If
Next lLoop
End With
End Sub
I'd like to extend this a little further, but I'm a little unsure about how to go about it.
What I'd like is to add an additional check which is:
Starting at row 7, if there is a value in Column I, look at Columns T:AE on the same row and if they are blank show the same error message and prevent the user from saving the file.
I'm certainly no expert in VBA, but I tried to add the following line after the 'Next lLoop'.
If Sheets("Input").Range("I1") > 0 And IsEmpty(Sheets("Input").Range("T1:AE1")) Then
MsgBox "I'm sorry, your record(s) contain incomplete fields and the file cannot be saved. Please correct these and try again"
Although no error message is returned, this piece of the script isn't working because the file can still be saved with these cells blank.
I just wondered whether someone could possibly take a look at this please and let me know where I'm going wrong.
Many thanks and kind regards
Chris
Using a solution I found here http://www.ozgrid.com/forum/showthread.php?t=57929 I've put together the following script which prevents users from saving a file if key cells are empty.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim rFound As Range
Dim strFind As String
Dim lLoop As Long
On Error Resume Next
With Sheets("Input")
For lLoop = 1 To 9
strFind = Choose(lLoop, "--Select--", "Enter your FTE", "Enter the Project Code", "Enter the name of the Project", _
"Enter the Work Package description", "Enter the name of the Enhancement(s)", "Enter the Work Package End Date", _
"Enter the name of your Work Manager", "Enter the name of your Line Manager")
Set rFound = .Range("B7:S400").Find(What:=strFind, After:=.Range("B7"), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
On Error GoTo 0
If Not rFound Is Nothing Then
If IsEmpty(rFound(1, 2)) Then
MsgBox "I'm sorry, your record(s) contain incomplete fields and the file cannot be saved. Please correct these and try again"
Cancel = True
End If
End If
Next lLoop
End With
End Sub
I'd like to extend this a little further, but I'm a little unsure about how to go about it.
What I'd like is to add an additional check which is:
Starting at row 7, if there is a value in Column I, look at Columns T:AE on the same row and if they are blank show the same error message and prevent the user from saving the file.
I'm certainly no expert in VBA, but I tried to add the following line after the 'Next lLoop'.
If Sheets("Input").Range("I1") > 0 And IsEmpty(Sheets("Input").Range("T1:AE1")) Then
MsgBox "I'm sorry, your record(s) contain incomplete fields and the file cannot be saved. Please correct these and try again"
Although no error message is returned, this piece of the script isn't working because the file can still be saved with these cells blank.
I just wondered whether someone could possibly take a look at this please and let me know where I'm going wrong.
Many thanks and kind regards
Chris