VB code help

G

Guest

Hi all,
I have had help putting this code together, but can't get it to work
properly. The code checks a worksheet named 'sweep log' Column C for today's
date, if its not found then a msg box "todays date not found" is displayed,
or if it is found then a check that data is also entered into the adjoining
columns D and E.
Problem is that the checks are carried out and the correct msg boxes are
shown but on acknowledment of these the worlsheet closes, instead of allowing
the data to be entered.
The code has been placed within the Before Close event, and is shown here...

Dim TimeCheck As Date
TimeCheck = Format(Now(), "h:mm")
If TimeCheck > "09:00" Then

Dim WS As Worksheet
Dim sRng As Range
Dim x As Object
Dim sDate As Date

sDate = DateSerial(Year(Now()), Month(Now()), Day(Now()))


Set WS = Sheets("sweep log")
With WS
Set sRng = Range(Cells(6, 3), Cells(65536, 3).End(xlUp))
Set x = sRng.Find(What:=sDate, LookIn:=xlFormulas, SearchDirection:=xlNext)

If x Is Nothing Then
MsgBox "Todays Date not found" ' edit as needed
SweepCheck = False
Exit Sub
End If
If ActiveCell.Offset(0, 2) <> "Y" Then
If ActiveCell.Offset(0, 1) = "" Then 'change to Yes if needed
MsgBox "verify sweep completed"
'this is old location
WS.Activate 'if "Y" is not found in same row as todays date then go to the
empty cell below
x.Offset(0, 2).Select
Exit Sub
End If 'this is new location
End If
End With
End If

it must be something simple, but being a novice, I can't put my finger on it

any help apreciated
thanks
 
N

Norman Jones

Hi Anthony,

You need to cancel the closure of the workbook at some point.

Try inserting:

Cancel = True

after:
x.Offset(0, 2).Select

I have not otherwise looked at your code.
 
G

Guest

Norman,
thanks for help, but by inserting Cancle=True didn't actualy do anything!
any other ideas ?
thanks
 
N

Norman Jones

Hi Anthony
Norman,
thanks for help, but by inserting Cancle=True didn't actualy do anything!
any other ideas ?
thanks

I may have mis read your code.

Try inserting the

Cancel = True

instruction after the line:

The workbook_BeforeClose procedure is invoked when an instruction to close
the workbook is issued. Including the instruction Cancel = True cancels the
original close instruction.

If, the code correctly reaches the MsgBox line, then the Cancel instruction
should prevent the file from closing.
 
B

Bob Phillips

Dim TimeCheck As Date
Dim WS As Worksheet
Dim sRng As Range
Dim x As Object
Dim sDate As Date

TimeCheck = Format(Now(), "h:mm")
If TimeCheck > "09:00" Then

sDate = DateSerial(Year(Now()), Month(Now()), Day(Now()))

Set WS = Sheets("sweep log")
With WS
Set sRng = Range(Cells(6, 3), Cells(65536, 3).End(xlUp))
Set x = sRng.Find(What:=sDate, LookIn:=xlFormulas,
SearchDirection:=xlNext)

If x Is Nothing Then
MsgBox "Todays Date not found" ' edit as needed
Cancel = True
Exit Sub
End If
If ActiveCell.Offset(0, 2) <> "Y" Then
If ActiveCell.Offset(0, 1) = "" Then 'change to Yes if
needed
MsgBox "verify sweep completed"
'this is old location
WS.Activate 'if "Y" is not found in same row as todays _
'date then go to the empty cell below
x.Offset(0, 2).Select
Cancel = True
Exit Sub
End If 'this is new location
End If
End With
End If


--

HTH

RP
(remove nothere from the email address if mailing direct)
 
G

Guest

As always - Bob to the rescue !
Thanks

Bob Phillips said:
Dim TimeCheck As Date
Dim WS As Worksheet
Dim sRng As Range
Dim x As Object
Dim sDate As Date

TimeCheck = Format(Now(), "h:mm")
If TimeCheck > "09:00" Then

sDate = DateSerial(Year(Now()), Month(Now()), Day(Now()))

Set WS = Sheets("sweep log")
With WS
Set sRng = Range(Cells(6, 3), Cells(65536, 3).End(xlUp))
Set x = sRng.Find(What:=sDate, LookIn:=xlFormulas,
SearchDirection:=xlNext)

If x Is Nothing Then
MsgBox "Todays Date not found" ' edit as needed
Cancel = True
Exit Sub
End If
If ActiveCell.Offset(0, 2) <> "Y" Then
If ActiveCell.Offset(0, 1) = "" Then 'change to Yes if
needed
MsgBox "verify sweep completed"
'this is old location
WS.Activate 'if "Y" is not found in same row as todays _
'date then go to the empty cell below
x.Offset(0, 2).Select
Cancel = True
Exit Sub
End If 'this is new location
End If
End With
End If


--

HTH

RP
(remove nothere from the email address if mailing direct)
 
G

Guest

oops my mistake,
the code supplied by Bob and Norman works better but even after entering all
the data into columns C,D and E I still get the propmt to enter data, the
workbook should now close,
any other ideas
 
B

Bob Phillips

I just tested it, and it seems to work.

Are you sure you have those dates and a Y offset 2 columns?

BTW, I only coded what Norman suggested :))

--

HTH

RP
(remove nothere from the email address if mailing direct)
 
G

Guest

Bob,
I have today's date in C7, a 'name' in D7 and 'Y' in E7 and still get reply
"varify sweep completed"
so what am I doing wrong as to complete the log and close the worksheet if
todays date is found in Column C a name shud be in column D and a 'Y' in E,
if not then the error respnse.
cheers
 
N

Norman Jones

Hi Anthony,

This may be getting nearer to what you want:

'==========>>
Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim TimeCheck As Date
Dim WS As Worksheet
Dim sRng As Range
Dim x As Object
Dim sDate As Date

TimeCheck = Format(Now(), "h:mm")
If TimeCheck > "09:00" Then

sDate = DateSerial(Year(Now()), Month(Now()), Day(Now()))

Set WS = Sheets("sweep log")
With WS
Set sRng = Range(Cells(6, 3), Cells(65536, 3).End(xlUp))
Set x = sRng.Find(What:=sDate, LookIn:=xlFormulas, _
SearchDirection:=xlNext)

If x Is Nothing Then
MsgBox "Todays Date not found" ' edit as needed
Cancel = True
Exit Sub
End If
If x.Offset(0, 2) <> "Y" Then
If x.Offset(0, 1) = "" Then 'change to Yes if needed
MsgBox "verify sweep completed"
'this is old location
WS.Activate 'if "Y" is not found in same row as todays _
'date then go to the empty cell below
x.Offset(1).Select
Cancel = False
Exit Sub
End If 'this is new location
End If
End With
End If
End Sub
'<<==========

However several things are unclear to me.

If today's date is found, must both the corresponding D an F cells be
populated?

If the D / F cells are not populated, which cell is to be selected. The
changes in the above code relect my (current) best guesses.
 
G

Guest

Norman
This code, given by Bob and yourself........

Dim TimeCheck As Date
Dim WS As Worksheet
Dim sRng As Range
Dim x As Object
Dim sDate As Date

TimeCheck = Format(Now(), "h:mm")
If TimeCheck > "09:00" Then

sDate = DateSerial(Year(Now()), Month(Now()), Day(Now()))

Set WS = Sheets("sweep log")
With WS
Set sRng = Range(Cells(6, 3), Cells(65536, 3).End(xlUp))
Set x = sRng.Find(What:=sDate, LookIn:=xlFormulas,
SearchDirection:=xlNext)

If x Is Nothing Then
MsgBox "Todays Date not found" ' edit as needed
Cancel = True
Exit Sub
End If
If ActiveCell.Offset(0, 2) <> "Y" Then
If ActiveCell.Offset(0, 1) = "" Then 'change to Yes ifneeded
MsgBox "verify sweep completed"
'this is old location
WS.Activate 'if "Y" is not found in same row as todays _
'date then go to the empty cell below
x.Offset(0, 2).Select
Cancel = True
Exit Sub
End If 'this is new location
End If
End With
End If



.....this kinda works but as I said before if you have data entered into
columns C,D and E it still shows the "verify sweep complete" msg box, where
as it should exit
any ideas as to why this is not working?
thanks every so much
Anthony
 
N

Norman Jones

Hi Anthony,

My posted code is a little different. Did you try it,

In my test book, if columns C,D and E are correctly populated, the file
closes.
 
G

Guest

Norman,
Ok I placed your code into my Beforeclose event so removing the Private Sub
Workbook_BeforeClose(Cancel As Boolean) at the top and the End Sub at the
end. But still the workbook closes after showing the "varify sweep complete"
msg box.
Can you tell me exactly what data you placed in cells C7,D7 and E7 to make
it work??
Also sorry I missed you other questions, didn't notice them at the end, so
in answer to them....

If today's date is found, must both the corresponding D an E cells be
populated?
Yes

If the D / E cells are not populated, which cell is to be selected. The
changes in the above code relect my (current) best guesses.
If the date is found but no other data then either column D or E can be
selected

Hope this helps, now can you solve it for me
thanks again
Anthony
 
B

Bob Phillips

Anthony,

I found it failed if the date cell contained a formula date, so I change dit
to this and it works, at least for me

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim TimeCheck As Date
Dim WS As Worksheet
Dim sRng As Range
Dim x As Object
Dim sDate As Date

TimeCheck = Format(Now(), "h:mm")
If TimeCheck > "09:00" Then

sDate = DateSerial(Year(Now()), Month(Now()), Day(Now()))

Set WS = Sheets("sweep log")
With WS
Set sRng = Range(Cells(6, 3), Cells(Rows.Count, 3).End(xlUp))
Set x = sRng.Find(What:=sDate, LookIn:=xlValues, _
SearchDirection:=xlNext)

If x Is Nothing Then
MsgBox "Todays Date not found" ' edit as needed
Cancel = True ElseIf x.Offset(0, 2) <> "Y" Then
If x.Offset(0, 1) = "" Then 'change to Yes if needed
MsgBox "verify sweep completed"
'this is old location
WS.Activate 'if "Y" is not found in same row as todays _
'date then go to the empty cell below
x.Offset(1).Select End If 'this is new
location
End If
End With
End If
End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)
 
N

Norman Jones

Hi Anthony,
Can you tell me exactly what data you placed in cells C7,D7 and
E7 to make it work??

For test purposes, I made the very simplest of worksheets: I entered a
sequence of dates in cells C6:C21; the date in cell C11 being today's date.
In D11 I entered a name and in E11 I entered Y.

With this arrangement the workbook closes; if I then delete the name entry,
I get the msgbox and the workbook remains open.

In this simple test, no other cells were populated.

You did notice that, in the second instance, I set Cancel = True


Regards,
Norman
 
G

Guest

Bob,
see my last post to Norman, his code almost worked, the one you just posted,
again closes without alowing user to input data -
helllpppp !
 
N

Norman Jones

Hi Anthony,

Bob's code worked for me providing I added:

Cancel = True

after the line:
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top