Rob_010101
Board Regular
- Joined
- Jul 24, 2017
- Messages
- 198
- Office Version
- 365
- Platform
- Windows
Hi All,
My team use a shared, macro-enabled (.xlsm) workbook, with roughly 25 users in it at the same time, 24 hours a day.
Over a few days, the shared user list gets full up, sometimes people's entries appear in there 4 or 5 times each. This causes the workbook to get bogged down which eventually results in it becoming corrupted and most of the time data loss occurrs as a system backup has to be restored through 'previous versions' in the folder properties.
My only way to fix this at the moment is to regularly ask everyone to save their work and exit the spreadhseet, so I can unshare and re-share it, which clears the list. The issue with this is when multiple users try to save at the same time, the 'file locked' message appears, so each of the 25 odd users has to keep trying to save until they've all saved which ends up being hours sometimes that the spreadsheet is out of use. Then each has to confirm via email they've saved and exited (as I have to temporarily move the spreadsheet from the shared drive to my desktop to stop it being accessed whilst I'm trying to fix it).
With users all over the globe, working at all different times, this is just a complete pain in the posterior, as you can probably imagine. Also, despite being told not to numerous times, users leave the shared excel open and then log off, disconnecting the VPN, when they've finished their shift. I'm pretty sure this doesn't help the situation.
So I did a little bit of digging, and came accross the following VBA code (from Super User) which is supposed to remove all shared users who have been in the workbook for more than X hours.
I'm using all of the below macros but can't get the bolded "SharedUserCheck" macro to work.
I click run, I get a spinning wheel and then nothing happens (entires greater than 12 hours are still there). I'm trying to run this with the workbook still shared, as this is supposed to work:
I've got very minimal knowledge of VBA code, so wondering if someone could provide a simple explanation, for a beginner?
I'm using Microsoft Office Standard 2016.
Kind Regards
Chris
My team use a shared, macro-enabled (.xlsm) workbook, with roughly 25 users in it at the same time, 24 hours a day.
Over a few days, the shared user list gets full up, sometimes people's entries appear in there 4 or 5 times each. This causes the workbook to get bogged down which eventually results in it becoming corrupted and most of the time data loss occurrs as a system backup has to be restored through 'previous versions' in the folder properties.
My only way to fix this at the moment is to regularly ask everyone to save their work and exit the spreadhseet, so I can unshare and re-share it, which clears the list. The issue with this is when multiple users try to save at the same time, the 'file locked' message appears, so each of the 25 odd users has to keep trying to save until they've all saved which ends up being hours sometimes that the spreadsheet is out of use. Then each has to confirm via email they've saved and exited (as I have to temporarily move the spreadsheet from the shared drive to my desktop to stop it being accessed whilst I'm trying to fix it).
With users all over the globe, working at all different times, this is just a complete pain in the posterior, as you can probably imagine. Also, despite being told not to numerous times, users leave the shared excel open and then log off, disconnecting the VPN, when they've finished their shift. I'm pretty sure this doesn't help the situation.
So I did a little bit of digging, and came accross the following VBA code (from Super User) which is supposed to remove all shared users who have been in the workbook for more than X hours.
I'm using all of the below macros but can't get the bolded "SharedUserCheck" macro to work.
I click run, I get a spinning wheel and then nothing happens (entires greater than 12 hours are still there). I'm trying to run this with the workbook still shared, as this is supposed to work:
VBA Code:
Sub Clean_Up()
'Clean up Extra Data to prevent file from being sluggish
Dim cv As CustomView
For Each cv In ActiveWorkbook.CustomViews
cv.Delete
Next cv
SharedUserCheck
End Sub
Sub SharedUserCheck()
'Remove old users to speed up shared workbook
Dim TimeStart As Date
Dim TimeLimit As Date
Dim SharedDuration As Date
Dim Users As Variant
Dim UserCount As Integer
'Set time limit here in "HH:MM:SS"
TimeLimit = TimeValue("12:00:00")
Users = ActiveWorkbook.UserStatus
For UserCount = UBound(Users) To 1 Step -1
TimeStart = Users(UserCount, 2)
SharedDuration = Now - TimeStart
If SharedDuration > TimeLimit Then
'MsgBox (Users(UserCount, 1) & " has been inactive for " & Application.Text(SharedDuration, "[hh]:mm") & " and will now be removed from the workbook.")
ThisWorkbook.RemoveUser (UserCount)
End If
Next
End Sub
Public Sub RemoveOtherUsers()
'Remove all other users to prevent access violation
Dim Users As Variant
Dim UserCount As Integer
Users = ThisWorkbook.UserStatus
For UserCount = UBound(Users) To 1 Step -1
If Users(UserCount, 1) <> Application.UserName Then
ThisWorkbook.RemoveUser (UserCount)
End If
Next
End Sub
Public Sub SundayMaintenance()
Application.ScreenUpdating = False
'On every Sunday the first time the sheet is opened clear out extra data and extra sheets
If (WeekdayName(Weekday(Date)) = "Sunday") And (Sheets(1).Cells(3, "AG").Value < Date) Then
'Disconnect other users as a precaution
RemoveOtherUsers
Application.DisplayAlerts = False
'Unshare to clear extra data out
ThisWorkbook.UnprotectSharing ("Whatever Password")
Application.DisplayAlerts = True
'Set Change History to 1 day to prevent build up of junk in the file
With ThisWorkbook
If .KeepChangeHistory Then
.ChangeHistoryDuration = 1
End If
End With
'Store Last Date Unshared and Cleared to prevent multiple unshare events on sunday.
Sheets(1).Cells(3, "AG").Value = Date
'Delete all extra sheets that were added by mistake and have the word sheet in them
For Each WS In ThisWorkbook.Worksheets
If UCase(WS.Name) Like "Sheet" & "*" Then
Application.DisplayAlerts = False
WS.Delete
Application.DisplayAlerts = True
End If
Next
'Reshare
Application.DisplayAlerts = False
ThisWorkbook.ProtectSharing Filename:=ThisWorkbook.FullName, SharingPassword:="Whatever Password"
Application.DisplayAlerts = True
End If
Application.ScreenUpdating = True
End Sub
I've got very minimal knowledge of VBA code, so wondering if someone could provide a simple explanation, for a beginner?
I'm using Microsoft Office Standard 2016.
Kind Regards
Chris