Extending existing coding to include new parameters
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
|