Hi
I want to know how to create a macro which enables a group of users to
share access to a daily copy of a workbook in such a way that the
first user to open the file every day gets a blank copy, with
subsequent users seeing data already enetered.
The macro will run automatically when a workbook is opened (I know how
to do this bit) and will check for the existence of a daily copy of
the workbook. If today's copy of the file doesn't exist the macro
should save the current workbook with a name based on today's date
which will be in cell A1 (simply using the number value of the date
would be acceptable although something a little more user friendly
would be better). If today's copy already exists then the macro should
close the original file and open the daily copy. If the daily file is
currently opened by another user the macro should terminate neatly
(possibly reporting which user has the file open).
For a tip, include another macro which checks a row of 6 cells and
fills the leftmost empty one with the current time rounded to the
nearest five minutes. Ideally this macro would be activated by a user
pusing a button in the spreadsheet itself.
Thanks for reading this

Dim WExcel As Excel.Application, WBook As Excel.Workbook, WSheet As Excel.Worksheet
    Set WExcel = New Excel.Application
    
    Dim WorkbookShareLocation As String
    Dim TodaysDate As String
    Dim DateTdy As Date
    
    WorkbookShareLocation = "C:\"
    TodaysDate = Format(Date, "dd")
    TodaysDate = TodaysDate & "-" & Format(Date, "mm")
    TodaysDate = TodaysDate & "-" & Format(Date, "yy")
    
    If Workbooks.Item.ReadOnly = True Then
        MsgBox ActiveWorkbook.UserStatus(1, 1) & " is currently in the
file", vbInformation, "Read Only"
        Workbooks.Close
    End If
    
    If Len(Dir(WorkbookShareLocation & TodaysDate & ".xls")) <> 0 Then
        Set WBook = WExcel.Workbooks.Open(WorkbookShareLocation &
TodaysDate & ".xls")
    Else
        MsgBox "File not found, creating new one"
        ActiveWorkbook.SaveAs (WorkbookShareLocation & TodaysDate & ".xls")
    End If

You will need to explain the bit about the rounding to the nearest
five minutes as i dont understand that bit.

This is "configured" for uk date format and does need a little code
tidying up but test this and tell me what you think

Scrap that last one, this one works better

    Dim WorkbookShareLocation As String
    Dim TodaysDate As String
    Dim DateTdy As Date
    
    WorkbookShareLocation = "C:\"
    TodaysDate = Format(Date, "dd")
    TodaysDate = TodaysDate & "-" & Format(Date, "mm")
    TodaysDate = TodaysDate & "-" & Format(Date, "yy")
    
    If ActiveWorkbook.ReadOnly = True Then
        MsgBox ActiveWorkbook.UserStatus(1, 1)
        Workbooks.Close
    End If
    
    If Len(Dir(WorkbookShareLocation & TodaysDate & ".xls")) <> 0 Then
        Workbooks.Open (WorkbookShareLocation & TodaysDate & ".xls")
    Else
        MsgBox "File not found, creating new one"
        ActiveWorkbook.SaveAs (WorkbookShareLocation & TodaysDate & ".xls")
    End If

Chris - thanks for your efforts. However there are still a couple of problems.
The first time the macro runs it does what it should. However,
subsequent runs on the same day start by generating a message that the
'daily' sheet is already open requiring the user to press 'yes' to
confirm they want to open it. I would much prefer this not to happen.
Perhaps more importantly the macro fails to close the original sheet.

The bit about the nearest five minutes meant that for instance at 9:02
it would enter 9:00 but at 9:03 it would enter 9:05

I am back on my network now at work so let me play with this script in
a network environment and get back to you.

I believe so far that the script does what you want apart from a
couple of minor adjustments.

It was all i could throw together at eleven at night after a hard days work!

The problem with the code i am doing is that whenever you open a
spreadsheet that isnt the current day it will try and open the current
day?

I think if you had a designated "master" file then i could tell the
code to check if the master file is opened then try and open the daily
sheet or just open the file that you want to view?

You know what i mean?

I will designate a variable that you can place the master sheet name
in so that the code checks if you have opened the master sheet and it
make a decision from there.

Right, how does this look

    Dim WorkbookShareLocation As String
    Dim TodaysDate As String
    Dim MasterSheet As String
    
    WorkbookShareLocation = "C:\"
    MasterSheet = "Master.xls"
    
    TodaysDate = Format(Date, "dd")
    TodaysDate = TodaysDate & "-" & Format(Date, "mm")
    TodaysDate = TodaysDate & "-" & Format(Date, "yy")
    
    If ActiveWorkbook.ReadOnly = True Then
        MsgBox ActiveWorkbook.UserStatus(1, 1)
        Workbooks.Close
    End If
    
    If Me.Name = TodaysDate & ".xls" Then
        Exit Sub
    End If
    
    If Me.Name = MasterSheet Then
        If Len(Dir(WorkbookShareLocation & TodaysDate & ".xls")) <> 0 Then
            Workbooks.Open (WorkbookShareLocation & TodaysDate & ".xls")
            Me.Close
        Else
            MsgBox "File not found, creating new one"
            ActiveWorkbook.SaveAs (WorkbookShareLocation & TodaysDate & ".xls")
        End If
    End If

You will need to change the MasterSheet variable to whatever the
master sheet will be.

I also need more clarification on what this time function is about,
you say check 6 rows and fill the left most with the time?

Check the 6 cells for what?

Im sorry but i keep looking over this and cant get my head around what
you want from this?

This version seems to handle memory better

    Dim WorkbookShareLocation As String
    Dim TodaysDate As String
    Dim MasterSheet As String
    
    WorkbookShareLocation = "C:\"
    MasterSheet = "Master.xls"
    
    TodaysDate = Format(Date, "dd")
    TodaysDate = TodaysDate & "-" & Format(Date, "mm")
    TodaysDate = TodaysDate & "-" & Format(Date, "yy")
    
    If ActiveWorkbook.ReadOnly = True Then
        MsgBox ActiveWorkbook.UserStatus(1, 1)
        Workbooks.Close
    End If
    
    If Me.Name = TodaysDate & ".xls" Then
        Exit Sub
    End If
    
    If Me.Name = MasterSheet Then
        If Len(Dir(WorkbookShareLocation & TodaysDate & ".xls")) <> 0 Then
            Workbooks.Open (WorkbookShareLocation & TodaysDate & ".xls")
            Workbooks(MasterSheet).Close
        Else
            MsgBox "File not found, creating new one"
            ActiveWorkbook.SaveAs (WorkbookShareLocation & TodaysDate & ".xls")
        End If
    End If

Here is the code to add a time to a cell from a button, it rounds up
as you requested.

Change the ActiveCell code to be whatever cell you want to put the time in

I have tested this with a lot of times and it seems to work pretty well.

Hope you like that

Help if i added it!

    Dim Minutes As Variant
    Dim Hours As Variant
    Dim TimeNow As String
    
    Hours = Format(Time, "hh")
    Minutes = Format$(Time, "nn")
        
    If Right(Minutes, 1) < 3 Then
        Minutes = Left(Minutes, 1) & 0
    ElseIf Right(Minutes, 1) > 7 Then
        Minutes = (Left(Minutes, 1) + 1) & 0
            If Minutes = 50 Then
                Hours = Hours + 1
                Minutes = 0
            End If
    Else
        Minutes = Left(Minutes, 1) & 5
    End If
    
    TimeNow = Hours & ":" & Minutes
           
    Range("A1").Select 'Change this to whatever cell you want to add time to
    
    ActiveCell.Value = TimeNow
    ActiveCell.NumberFormat = "hh:mm"

Hi Chris. Thanks for continuing to stick with this - but please don't
make yourself ill by trying to respond after 11pm and a full day's
work!

I'm sorry I didn't make myself sufficiently clear with the problem I
encountered with your second macro (14 Aug 2006 15:29 PDT). What I
want to end up with is a spreadsheet that a number of users can have a
shortcut to on their desktop. It's going to be used as a group
timesheet. When the first member of staff comes in to the office they
hit the shortcut which launches the spreadsheet (I think this might be
what you mean by the master spreadsheet). When it opens it runs your
macro which checks to see if a copy for today has been created. If it
hasn't, it creates it. The user then enters their start time and
closes it. If it has been created (i.e. this isn't the first person in
to the office), it opens the daily copy and shuts itself. The user
then adds their start time and closes it. The sheet would be used by a
number of users several times throughout the day.
The problem with your macro is that when a user other than the first
opens the sheet, a message is returned saying that the sheet is
already open (even though it isn't). I realise that the user simply
has to press 'yes' to continue to open the sheet but it isn't very
elegant.

I'm afraid I can't test your macro of 15 Aug 2006 14:38 PDT as it
returns an error on my system (Excel 2003):

Compile error:
Invalid use of Me keyword

As far as the 'time' macro is concerned, I wanted it to be activated
by a button actually in a cell in the spreadsheet. It would check for
the first empty cell in a specified range and enter the time value
there. The idea is that when the user opens the timesheet they have a
button in their row of the sheet which they can click on to
automatically enter the current time (to the nearest 5 minutes) in to
the first empty cell in their row (so when they arrivein the office,
they click it and the time of arrival is entered in the first cell.
When they leave, they click it and the time of departure is entered in
the second. When they reappear later they click it and the third cell
is populated, etc.).

I suspect we are both trying to deal with this when we are tired at
the end of the day. If I still haven't made myself clear, then please
ask for clarification, rather than spending your time coding what you
think I might want. I don't have a deadline on this.