Reputation: 157
I have a spreadsheet that is shared and can be opened by multiple users. I want to have a separate tab with all the users of the spreadsheet and their last time of opening.
Firstly is this possible? I've heard there are limitations with shared worksheets, I have alternative ideas around this but this way would be best.
I haven't tried anything yet so apologies for lack of code but if anyone can point me in the right direction it'd be greatly appreciated.
Thanks!
Upvotes: 1
Views: 216
Reputation: 1156
Verison 2: No ListObject
This is a variation on my original answer. It seems that ListObjects may not be compatible with Shared workbooks, so this one just puts the data on a bare worksheet.
Option Explicit
Private Sub Workbook_Open()
Dim sh As Worksheet
Dim nextRow As Integer
Set sh = getSheet("TrackOpen")
'Make the sheet if it doesnt already exist
If sh Is Nothing Then
Set sh = ThisWorkbook.Worksheets.Add
With sh
.Name = "TrackOpen"
.Range("A1") = "User"
.Range("B1") = "Timestamp"
.Range("A1:B1").Font.Bold = True
End With
End If
With sh
nextRow = sh.Range("A" & sh.Rows.Count).End(xlUp).Row + 1
sh.Range("A" & nextRow) = Environ("Username")
sh.Range("B" & nextRow) = Now()
End With
'Optional, uncomment to save
'ThisWorkbook.Save
End Sub
Private Function getSheet(sheetName As String) As Worksheet
On Error GoTo uhoh
Set getSheet = ThisWorkbook.Sheets(sheetName)
Exit Function
uhoh:
Set getSheet = Nothing
End Function
Upvotes: 1
Reputation: 1156
This is totally possible.
Put this in the workbook module then manually run the Workbook_Open method once.
Option Explicit
Private Sub Workbook_Open()
Dim sh As Worksheet
Dim objList As ListObject
Dim listRow As listRow
Set sh = getSheet("TrackOpen")
'Make the sheet if it doesnt already exist
If sh Is Nothing Then
Set sh = ThisWorkbook.Worksheets.Add
sh.name = "TrackOpen"
End If
Set objList = getListObject("TBL_Logins")
'Make the table if it doesn't already exist
If objList Is Nothing Then
Set objList = ThisWorkbook.Sheets("TrackOpen").ListObjects.Add
With objList
.name = "TBL_Logins"
.ListColumns.Add
.ListColumns(1).name = "User"
.ListColumns(2).name = "Timestamp"
End With
End If
Set listRow = objList.ListRows.Add
With listRow
.Range(1, objList.ListColumns("User").Index) = Environ("Username")
.Range(1, objList.ListColumns("Timestamp").Index) = Now()
End With
'Optional, uncomment to save
'ThisWorkbook.Save
End Sub
Private Function getSheet(sheetName As String) As Worksheet
On Error GoTo uhoh
Set getSheet = ThisWorkbook.Sheets(sheetName)
Exit Function
uhoh:
Set getSheet = Nothing
End Function
Private Function getListObject(listName As String) As ListObject
Dim sh As Worksheet
Dim lst As ListObject
On Error GoTo uhoh
For Each sh In ThisWorkbook.Sheets
For Each lst In sh.ListObjects
If lst.name = listName Then Set getListObject = lst: Exit Function
Next lst
Next sh
uhoh:
Set getListObject = Nothing
End Function
Upvotes: 2