Hi All

I need some help to extend some existing VBA.

To indicate when the content on the sheet was last updated. I use this
code :

..Range("A21").Value = "Last Updated : " & Format(Now, " dddd dd/mm/yy
at hh:mm:ss")


It reads , for example :

Last Updated : Thursday 30/06/11 at 19:45:27


I need to extend it to include reference to shop opening and closing
times.

The shop is open between 8 am and 4.30 pm , and closed outside these
hours.

So the output of the new code would read something like :

Last Updated : Thursday 30/06/11 at 19:45:27 , when the shop was
closed.

Or

Last Updated : Thursday 30/06/11 at 11:45:27 , when the shop was
open.


Can someone help to extend the coding?


Grateful for any advice.

Try...

.Range("A21").Value = "Last Updated: " _
& Format(Now, " dddd dd/mm/yy at hh:mm:ss") _
& ", when the shop was " & Get_ShopOpenStatus(TimeValue(Now))


Function Get_ShopOpenStatus(CurrentTime As Variant) As String
Dim vShopOpens, vShopCloses
vShopOpens = TimeValue("8:00 AM")
vShopCloses = TimeValue("4:30 PM")
If TimeValue(Now) vShopOpens And TimeValue(Now) < vShopCloses Then
_
Get_ShopOpenStatus = "open." Else Get_ShopOpenStatus = "closed."
End Function

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Sorry Colin, I forgot to copy/paste the revised function!

Function Get_ShopOpenStatus(CurrentTime As Variant) As String
Dim vShopOpens, vShopCloses
vShopOpens = TimeValue("8:00 AM")
vShopCloses = TimeValue("4:30 PM")
If CurrentTime vShopOpens And CurrentTime < vShopCloses Then _
Get_ShopOpenStatus = "open." Else Get_ShopOpenStatus = "closed."
End Function

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

In article , GS writes
Try...

.Range("A21").Value = "Last Updated: " _
& Format(Now, " dddd dd/mm/yy at hh:mm:ss") _
& ", when the shop was " & Get_ShopOpenStatus(TimeValue(Now))


Function Get_ShopOpenStatus(CurrentTime As Variant) As String
Dim vShopOpens, vShopCloses
vShopOpens = TimeValue("8:00 AM")
vShopCloses = TimeValue("4:30 PM")
If TimeValue(Now) vShopOpens And TimeValue(Now) < vShopCloses Then
_
Get_ShopOpenStatus = "open." Else Get_ShopOpenStatus = "closed."
End Function



HI Garry

OK thanks for getting but so expertly.

I'm getting an 'Expected End Sub' error just before the line

Function Get_ShopOpenStatus(CurrentTime As Variant) As String

I'm placing your code in a Private Sub context under the tab on the
sheet. I wonder if this is causing the issue.

Thanks again for your help.

In article , GS writes
Sorry Colin, I forgot to copy/paste the revised function!

Function Get_ShopOpenStatus(CurrentTime As Variant) As String
Dim vShopOpens, vShopCloses
vShopOpens = TimeValue("8:00 AM")
vShopCloses = TimeValue("4:30 PM")
If CurrentTime vShopOpens And CurrentTime < vShopCloses Then _
Get_ShopOpenStatus = "open." Else Get_ShopOpenStatus = "closed."
End Function


Hi Garry

Sorry - here's the whole of the code I'm trying to fit yours into ;


Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo stoppit
Application.EnableEvents = False
If Me.Range("D4").Value < "" Then
With Sheets("ShareSheet")
.Unprotect Password:="password"
.Range("A21").Value = "Last Updated : " & Format(Now, " dddd
dd/mm/yy at hh:mm:ss")
stoppit:
Application.EnableEvents = True
.Protect Password:="password"
End With
End If
End Sub


I should have sent it before. It will make the picture clearer.

Best Wishes

Colin Hayes explained on 6/30/2011 :
In article , GS writes
Try...

.Range("A21").Value = "Last Updated: " _
& Format(Now, " dddd dd/mm/yy at hh:mm:ss") _
& ", when the shop was " & Get_ShopOpenStatus(TimeValue(Now))


Function Get_ShopOpenStatus(CurrentTime As Variant) As String
Dim vShopOpens, vShopCloses
vShopOpens = TimeValue("8:00 AM")
vShopCloses = TimeValue("4:30 PM")
If TimeValue(Now) vShopOpens And TimeValue(Now) < vShopCloses Then
_
Get_ShopOpenStatus = "open." Else Get_ShopOpenStatus = "closed."
End Function



HI Garry

OK thanks for getting but so expertly.

I'm getting an 'Expected End Sub' error just before the line

Function Get_ShopOpenStatus(CurrentTime As Variant) As String

I'm placing your code in a Private Sub context under the tab on the sheet. I
wonder if this is causing the issue.

Thanks again for your help.

Colin,
The line of code is a revised version of the snippet of code you
provided in your original post. Just replace your original line with
mine...!

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Colin Hayes has brought this to us :
In article , GS writes
Sorry Colin, I forgot to copy/paste the revised function!

Function Get_ShopOpenStatus(CurrentTime As Variant) As String
Dim vShopOpens, vShopCloses
vShopOpens = TimeValue("8:00 AM")
vShopCloses = TimeValue("4:30 PM")
If CurrentTime vShopOpens And CurrentTime < vShopCloses Then _
Get_ShopOpenStatus = "open." Else Get_ShopOpenStatus = "closed."
End Function


Hi Garry

Sorry - here's the whole of the code I'm trying to fit yours into ;


Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo stoppit
Application.EnableEvents = False
If Me.Range("D4").Value < "" Then
With Sheets("ShareSheet")
.Unprotect Password:="password"

Replace the following line with my revised version...
=======================================
.Range("A21").Value = "Last Updated : " & Format(Now, " dddd
dd/mm/yy at hh:mm:ss")
=======================================

stoppit:
Application.EnableEvents = True
.Protect Password:="password"
End With
End If
End Sub


I should have sent it before. It will make the picture clearer.

Best Wishes

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Hi Garry

Yes , that's what I'm doing , in precisely the way you indicate , but
I'm still getting this 'Expected End Sub' error. Just before the start
of the Function code. Very mysterious. I'll give it another go.

This is the code I'm using now , with your revision in place. Does it
look OK to you?


Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo stoppit
Application.EnableEvents = False
If Me.Range("D4").Value < "" Then
With Sheets("ShareSheet")
.Unprotect Password:="password"

.Range("A21").Value = "Last Updated: " _
& Format(Now, " dddd dd/mm/yy at hh:mm:ss") _
& ", when the shop was " & Get_ShopOpenStatus(TimeValue(Now))

Function Get_ShopOpenStatus(CurrentTime As Variant) As String
Dim vShopOpens, vShopCloses
vShopOpens = TimeValue("8:00 AM")
vShopCloses = TimeValue("4:30 PM")
If TimeValue(Now) vShopOpens And TimeValue(Now) < vShopCloses Then _
Get_ShopOpenStatus = "open." Else Get_ShopOpenStatus = "closed."
End Function

stoppit:
Application.EnableEvents = True
.Protect Password:="password"
End With
End If
End Function


Thanks again Garry





In article , GS writes
Colin Hayes has brought this to us :
In article , GS writes
Sorry Colin, I forgot to copy/paste the revised function!

Function Get_ShopOpenStatus(CurrentTime As Variant) As String
Dim vShopOpens, vShopCloses
vShopOpens = TimeValue("8:00 AM")
vShopCloses = TimeValue("4:30 PM")
If CurrentTime vShopOpens And CurrentTime < vShopCloses Then _
Get_ShopOpenStatus = "open." Else Get_ShopOpenStatus = "closed."
End Function


Hi Garry

Sorry - here's the whole of the code I'm trying to fit yours into ;


Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo stoppit
Application.EnableEvents = False
If Me.Range("D4").Value < "" Then
With Sheets("ShareSheet")
.Unprotect Password:="password"

Replace the following line with my revised version...
=======================================
.Range("A21").Value = "Last Updated : " & Format(Now, " dddd
dd/mm/yy at hh:mm:ss")
=======================================

stoppit:
Application.EnableEvents = True
.Protect Password:="password"
End With
End If
End Sub


I should have sent it before. It will make the picture clearer.

Best Wishes

The function is a separate procedure, and so does not go inside your
Change event. Put it in a standard module. Let me know how you make
out...

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo stoppit
Application.EnableEvents = False
If Me.Range("D4").Value < "" Then
With Sheets("ShareSheet")
.Unprotect Password:="password"
.Range("A21").Value = "Last Updated: " _
& Format(Now, " dddd dd/mm/yy at hh:mm:ss") _
& ", when the shop was " & Get_ShopOpenStatus(TimeValue(Now))

stoppit:
.Protect Password:="password"
End With
End If
Application.EnableEvents = True
End Sub

In a standard module...

Function Get_ShopOpenStatus(CurrentTime As Variant) As String
Dim vShopOpens, vShopCloses
vShopOpens = TimeValue("8:00 AM")
vShopCloses = TimeValue("4:30 PM")
If TimeValue(Now) vShopOpens And TimeValue(Now) < vShopCloses Then
_
Get_ShopOpenStatus = "open." Else Get_ShopOpenStatus = "closed."
End Function

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Geez.., did it again! Revise function in previous reply to...

Function Get_ShopOpenStatus(CurrentTime As Variant) As String
Dim vShopOpens, vShopCloses
vShopOpens = TimeValue("8:00 AM")
vShopCloses = TimeValue("4:30 PM")
If CurrentTime vShopOpens And CurrentTime < vShopCloses Then _
Get_ShopOpenStatus = "open." Else Get_ShopOpenStatus = "closed."
End Function

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

In article , GS writes
Geez.., did it again! Revise function in previous reply to...

Function Get_ShopOpenStatus(CurrentTime As Variant) As String
Dim vShopOpens, vShopCloses
vShopOpens = TimeValue("8:00 AM")
vShopCloses = TimeValue("4:30 PM")
If CurrentTime vShopOpens And CurrentTime < vShopCloses Then _
Get_ShopOpenStatus = "open." Else Get_ShopOpenStatus = "closed."
End Function



Hi Garry

OK that's fixed it. Working perfectly.

Thanks again for your time and considerable expertise.



Best Wishes


Colin

You're very welcome! Glad you were able to sort it out. Next time..,
I'll be less presumptuous!<g

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

In article , GS writes
You're very welcome! Glad you were able to sort it out. Next time..,
I'll be less presumptuous!<g


Hi Garry

Just out of interest , how would you add a colour (say Green) to the
word 'Open' in the Function code? I toyed with it but could find no
successful way. There seem to be many codes for colour implementation in
VBA, but none that work...


Function Get_ShopOpenStatus(CurrentTime As Variant) As String
Dim vShopOpens, vShopCloses
vShopOpens = TimeValue("8:00 AM")
vShopCloses = TimeValue("4:30 PM")
If TimeValue(Now) vShopOpens And TimeValue(Now) < vShopCloses Then _
Get_ShopOpenStatus = "open." Else Get_ShopOpenStatus = "closed."
End Function


Thanks Garry.

Colin Hayes presented the following explanation :
In article , GS writes
You're very welcome! Glad you were able to sort it out. Next time..,
I'll be less presumptuous!<g


Hi Garry

Just out of interest , how would you add a colour (say Green) to the word
'Open' in the Function code? I toyed with it but could find no successful
way. There seem to be many codes for colour implementation in VBA, but none
that work...


Function Get_ShopOpenStatus(CurrentTime As Variant) As String
Dim vShopOpens, vShopCloses
vShopOpens = TimeValue("8:00 AM")
vShopCloses = TimeValue("4:30 PM")
If TimeValue(Now) vShopOpens And TimeValue(Now) < vShopCloses Then _
Get_ShopOpenStatus = "open." Else Get_ShopOpenStatus = "closed."
End Function


Thanks Garry.

Well, I think you're gonna have to look at getting involved with
multiple properties and lots of character manipulation. I've never had
any need to do this programmatically so try doing it manually with the
macro recorder and see what, if any, code generates.

You might be better off just setting the cell's font to green for times
that fall into open hours.

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Colin,
I see that the macro recorder gives you everything you need for this.
What you might want to do is add a global variable (g_bOpenHours) to
manage the font coloring...

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo stoppit
Application.EnableEvents = False
If Me.Range("D4").Value < "" Then
With Sheets("ShareSheet")
.Unprotect Password:="password"
.Range("A21").Value = "Last Updated: " _
& Format(Now, " dddd dd/mm/yy at hh:mm:ss") _
& ", when the shop was " & Get_ShopOpenStatus(TimeValue(Now))

If g_bOpenHours Then Call FlagOpenHours
stoppit:
.Protect Password:="password"
End With
End If
Application.EnableEvents = True
End Sub

In a standard module:

Option Explicit

Public g_bOpenHours As Boolean


Sub FlagOpenHours()
Dim iPos As Integer
If g_bOpenHours Then
With ActiveSheet.Range("A21")
iPos = InStr(1, .Value, "open", vbTextCompare)
.Characters(Start:=iPos, Length:=4).Font.ColorIndex = 10
End With
g_bOpenHours = False '//reset flag
End If
End Sub

Function Get_ShopOpenStatus(CurrentTime As Variant) As String
Dim vShopOpens, vShopCloses
vShopOpens = TimeValue("8:00 AM")
vShopCloses = TimeValue("4:30 PM")
If CurrentTime vShopOpens And CurrentTime < vShopCloses Then
Get_ShopOpenStatus = "open.": g_bOpenHours = True '//turn flag ON
Else
Get_ShopOpenStatus = "closed."
End If
End Function

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

In article , GS writes
Well, I think you're gonna have to look at getting involved with multiple properties
and lots of
character manipulation. I've never had any need to do this programmatically so try
doing it manually
with the macro recorder and see what, if any, code generates.

You might be better off just setting the cell's font to green for times that fall into
open hours.

--
Garry

Hi Garry

OK thanks for that. I do now realise that colour is complicated. I've
seen your further message , and will have a go at this. Very
interesting.

I made an error in my earlier email. Or rather overlooked a parameter.
Apologies.

My 'shop' is closed at weekends , so the TimeValue in the function would
need to return 'Closed' on Saturdays and Sundays.

Function Get_ShopOpenStatus(CurrentTime As Variant) As String
Dim vShopOpens, vShopCloses
vShopOpens = TimeValue("8:00 AM")
vShopCloses = TimeValue("4:30 PM")
If CurrentTime vShopOpens And CurrentTime < vShopCloses Then _
Get_ShopOpenStatus = "open." Else Get_ShopOpenStatus = "closed."
End Function

I'm trying to include a 'Weekday' function in the code presently.



Best Wishes


Colin

In the code behind the worksheet:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo stoppit
Application.EnableEvents = False
If Me.Range("D4").Value < "" Then
With Sheets("ShareSheet")
.Unprotect Password:="password"
.Range("A21").Value = "Last Updated: " _
& Format(Now, " dddd dd/mm/yy at hh:mm:ss") _
& ", when the shop was " & Get_ShopOpenStatus(TimeValue(Now))

If g_bOpenHours Then Call FlagOpenHours(Sheets("ShareSheet"))
stoppit:
.Protect Password:="password"
End With
End If
Application.EnableEvents = True
End Sub


In a standard module:

Option Explicit

Public g_bOpenHours As Boolean


Sub FlagOpenHours(Optional Wks As Worksheet)
Dim iPos As Integer
If Wks Is Nothing Then Set Wks = ActiveSheet
If g_bOpenHours Then
With Wks.Range("A21")
iPos = InStr(1, .Value, "open", vbTextCompare)
.Characters(Start:=iPos, Length:=4).Font.ColorIndex = 10
End With
g_bOpenHours = False '//reset flag
End If
End Sub

Function Get_ShopOpenStatus(CurrentTime As Variant) As String
Dim vShopOpens, vShopCloses
vShopOpens = TimeValue("8:00 AM")
vShopCloses = TimeValue("4:30 PM")
If CurrentTime vShopOpens And CurrentTime < vShopCloses _
And Weekday(CurrentTime) 1 And Weekday(CurrentTime) < 7 Then
Get_ShopOpenStatus = "open.": g_bOpenHours = True '//turn flag ON
Else
Get_ShopOpenStatus = "closed."
End If
End Function

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

In article , GS writes
In the code behind the worksheet:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo stoppit
Application.EnableEvents = False
If Me.Range("D4").Value < "" Then
With Sheets("ShareSheet")
.Unprotect Password:="password"
.Range("A21").Value = "Last Updated: " _
& Format(Now, " dddd dd/mm/yy at hh:mm:ss") _
& ", when the shop was " & Get_ShopOpenStatus(TimeValue(Now))

If g_bOpenHours Then Call FlagOpenHours(Sheets("ShareSheet"))
stoppit:
.Protect Password:="password"
End With
End If
Application.EnableEvents = True
End Sub


In a standard module:

Option Explicit

Public g_bOpenHours As Boolean


Sub FlagOpenHours(Optional Wks As Worksheet)
Dim iPos As Integer
If Wks Is Nothing Then Set Wks = ActiveSheet
If g_bOpenHours Then
With Wks.Range("A21")
iPos = InStr(1, .Value, "open", vbTextCompare)
.Characters(Start:=iPos, Length:=4).Font.ColorIndex = 10
End With
g_bOpenHours = False '//reset flag
End If
End Sub

Function Get_ShopOpenStatus(CurrentTime As Variant) As String
Dim vShopOpens, vShopCloses
vShopOpens = TimeValue("8:00 AM")
vShopCloses = TimeValue("4:30 PM")
If CurrentTime vShopOpens And CurrentTime < vShopCloses _
And Weekday(CurrentTime) 1 And Weekday(CurrentTime) < 7 Then
Get_ShopOpenStatus = "open.": g_bOpenHours = True '//turn flag ON
Else
Get_ShopOpenStatus = "closed."
End If
End Function


Hi Garry

OK Thanks for that - Working perfectly.

I've managed to follow the logic of your procedures here. Very
impressive.



Best Wishes


Colin

You're very welcome! Always glad to help wherever I can...

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc