SadMrFrown
SadMrFrown

Reputation: 157

Show last time user opened a shared workbook in vba

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

Answers (2)

Valon Miller
Valon Miller

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

Valon Miller
Valon Miller

Reputation: 1156

This is totally possible.

Put this in the workbook module then manually run the Workbook_Open method once.

enter image description here

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

Related Questions