Extending existing coding to include new parameters

Colin Hayes · Jun 30, 2011

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.

GS · Jul 1, 2011

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

GS · Jul 1, 2011

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

Colin Hayes · Jul 1, 2011

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 Hayes · Jul 1, 2011

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

GS · Jul 1, 2011

Colin Hayes explained on 6/30/2011 :

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...!

GS · Jul 1, 2011

Colin Hayes has brought this to us :

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")
=======================================

Colin Hayes · Jul 1, 2011

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

GS · Jul 1, 2011

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...

GS · Jul 1, 2011

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

GS · Jul 1, 2011

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

Colin Hayes · Jul 1, 2011

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

GS · Jul 1, 2011

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

Colin Hayes · Jul 1, 2011

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.

GS · Jul 2, 2011

Colin Hayes presented the following explanation :

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.

GS · Jul 2, 2011

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

Colin Hayes · Jul 2, 2011

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.

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

GS · Jul 2, 2011

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

Colin Hayes · Jul 3, 2011

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

GS · Jul 3, 2011

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

Extending existing coding to include new parameters

Colin Hayes

GS

GS

Colin Hayes

Colin Hayes

GS

GS

Colin Hayes

GS

GS

GS

Colin Hayes

GS

Colin Hayes

GS

GS

Colin Hayes

GS

Colin Hayes

GS