TIMELINE with actual line that shows the time current time.

[Elvestad]

Hi!
I'm in greatly need of help. I'm currently working on updating a timeline for airplane flights in Excel, and I've met a wall (I've never used excel before). I use macros to add flights and change the status of a flight. Everything of the timeline is made in the cells in a worksheet. I dont use charts, or other objects/stuff like that (I dont understand them).

What i need help for, is to add a LINE that goes from the top to the bottom of the timeline, showing what the clock is. Every hour is split in 4 parts, so every 15 minutes i want it to change position to the right quarter of the hour. Want it to use the time of the computer ("=NOW()"). Don't want it to change anything on the sheet, when it moves from one quarter to another.

I don't know if this is possible, but I would be awesomesuperhappy if someone would help me with this.

Sorry for not having a picture of the worksheet. Not allowed to share it.

 

[Snakehips]

Elvestad,

Welcome to MrExcel.

A vertical line?
Does each column represent a 15 minute period?
What is the row number where the line top would be the top of the row?
What column where the line would be on the left edge of the column?
Is this line to keep going right with time or does it re-set left after say 24 hours?

 

[Elvestad]

Hi Snakehips. Yes, it's a vertical line. And yes, each column represent 15 min.
The top of the line would be at row 3 and the bottom at 42. I'm not sure if I understand "What column where the line would be", but the timeline starts from B3:B42, were the left side of the column would be at 06:00. I want it to re-set itself after a 24h period, or just follow the clock on the computer so it's always where it should be after I open the worksheet (and it have updatet itself or how it could work). Thank you for beeing intrested.

 

[Snakehips]

Sorry for the delay.

I was thinking that I could have got something working using conditional formatting on left border of cells. It was very close but for some reason not all cells reacted 'on time' and the line was fragmented until one or more in cell data changes were made. Seems odd to me since a I have never before had CF that has played up. Research would suggest that under certain circumstances, CF is a bit buggy.

So here is a possibility you may wish to try......

It is essentially an adaptation of some basic timer coding as originated by Chip Pearson. Here is a link to his article if you should care to read it.

From the Insert tab, insert a line or arrow connector or the like and size and position it vertically to coincide with the lefthand border of cells B3:B42.
With the line/arrow selected, make a note of it's name** as it appears in the name box, extreme left of the formula bar.

Right click sheet tab >> View code to open the vba editor .
In the project pane on the left, expand Microsoft objects so that you see your sheets and double click ThisWorkbook and paste the code below into the code pane on the right.

Private Sub Workbook_BeforeClose(Cancel As Boolean)StopTimer
End Sub



Private Sub Workbook_Open()
MoveTimeLine
End Sub

Then in the vba editor toolbar click Insert >> Module
Then paste the below code into the module's code pane.
Edit the sheet name to suit your worksheet.
Edit the line/arrow name to suit your inserted object.**

From your above post, B3 as the top left cell and 6 as 6am reset time should be ok.

Public RunWhen As Double
Public Const cRunWhat = "MoveTimeLine"  ' the name of the procedure to run




Sub StartTimer()
  '****Run 3 seconds after the next quarter hour mark ***
    RunWhen = TimeSerial(Hour(Time), (Int(Minute(Time) / 15) + 1) * 15, 3)
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
        Schedule:=True
End Sub
Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
        Schedule:=False
End Sub




Sub MoveTimeLine()


Dim rng As Range
 Dim OSet As Integer
 Dim ResetHr As Integer
 Dim q As Integer


 With Sheets("Sheet8")  '******Edit sheet name to suit ****
  
 Set rng = .Range("B3")  '****Edit to suit line Datum = cell left & cell top
                          
 ResetHr = 6    '***** Reset hour  edit to suit *******
 
 Diff = Hour(Time) - ResetHr
Select Case Diff
Case 0
Diff = 0
Case Is < 0
Diff = 24 + Diff
q = 1
Case Else
End Select


OSet = (Diff * 4) + (Int(Minute(Time)) / 15) - q
   .Shapes("Straight Arrow Connector 2").Top = rng.Offset(0, OSet).Top  '*** Edit shape name to suit***
   .Shapes("Straight Arrow Connector 2").Left = rng.Offset(0, OSet).Left '*** Edit shape name to suit***
 End With
StartTimer
 
End Sub

Then you should be good to test it.

Position your line somewhere on the sheet but not at the correct time. Then run the MoveTimeLine macro and it should position correctly (Fingers crossed!!)
Having run that macro the once will have run StartTimer and set that to run MoveTimeLine again in 15 minutes.
That should then run every 15 minutes until you run the StopTimer macro.
Then test it again by moving the arrow >> close the workbook which should automatically run StopTimer.
Then when you open the workbook again it should auto run MoveTimeLine which will then auto run StartTimer and set up the 15 minute repeats.

I hope that all makes sense, and actually works??!!

 

[Snakehips]

Slight revision to this particular bit of code so that it will update if other workbooks are open at the same time.

Edit the workbook name to suit.

Sub MoveTimeLine()


Dim rng As Range
 Dim OSet As Integer
 Dim ResetHr As Integer
 Dim q As Integer
 Dim wb As Workbook
 Set wb = Workbooks("MyTest.xlsm")  '***** Edit workbook name to suit"


 With wb.Sheets("Sheet8")  '******Edit sheet name to suit ****
  
 Set rng = .Range("B3")  '****Edit to suit line Datum = cell left & cell top
                          
 ResetHr = 6    '***** Reset hour  edit to suit *******
 
 Diff = Hour(Time) - ResetHr
Select Case Diff
Case 0
Diff = 0
Case Is < 0
Diff = 24 + Diff
q = 1
Case Else
End Select


OSet = (Diff * 4) + (Int(Minute(Time)) / 15) - q
   .Shapes("Straight Arrow Connector 2").Top = rng.Offset(0, OSet).Top  '*** Edit shape name to suit***
   .Shapes("Straight Arrow Connector 2").Left = rng.Offset(0, OSet).Left '*** Edit shape name to suit***
 End With
StartTimer
 
End Sub

 

[Elvestad]

Wow Tony, I'm amazed by your help! Thanks. I have to test this in a week though, since I'm of shift untill next monday. So we'll see then!
I did read through the code u posted, and it makes sense (Even though i didnt understand it all).

 

[Elvestad]

I may try to recreate the timeline at home and try it there. This is intresting!
Thanks again for trying to help me with this case.

 

[Snakehips]

Here is a link to my simple test workbook at DropBox .... LINK

 

[Elvestad]

Hi again, I'm back on work. By the way, it works! This is awesome. Thank you so much.
I got a bit confused, since StopTimer didn't work at first, but after a while I realized that I just had to move it a line down. Thank you for helping me with this, Tony. I'm really greatfull. It's so interesting to read through this code, I understand it but could never write it myself. Thanks!

One final question? Is there a way to make this work for several worksheets in a workbook? This isn't that important tho, we saves each day induvidually atm.

Thanks again!

 

[Snakehips]

Elvestad,

I'm pleased it worked for you.

Re applying to several sheets. Yes it can be done but he approach would depend upon circumstances.

How many sheets?
Will the datum cell be the same in each sheet?
Will the start time be 6 in all cases?
Might these sheets all be consecutive tabs that will always be in the same tab position/tab order?
The above would mean that we can refer to the sheets by index number rather than name.