2

I have 10 or so Shared Macro Enabled Excel files that about 30-50 users modify multiple times each day. Over time the files get bogged down and bloated from excel thinking users are still using them even though they are not. If I do not unshare and reshare the files occasionally they eventually become corrupt.

My question is what is the best way to prevent this?

My original idea was to write a macro that un-shared all of the files and then re-shared them to get rid of the junk. The down side to this is that it would kick all current users out so I decided against that.

After thinking about it for awhile I came up with a possible solution. Please critique my answer and help me improve upon it or if you have a better solution please let me know.

2
  • How is it shared? Why not use sharepoint and have user check in and check out the docs? Aug 24, 2015 at 17:22
  • It is shared using the Share Workbook option under the review tab. If we use excel to open the file in share point it locks the file to one user we are not able to use this feature due to that.
    – Matt
    Aug 24, 2015 at 22:37

1 Answer 1

3

For my solution I made a macro that clears all the custom views and compares how long a user has been inactive and then kicks them out if they are over the time limit. I run Clean_Up when the files are opened.

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("02: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

Update: 9/1/15 So it has been a week or so without any problems I have noticed however that some of the files have started to get a little bigger.

I believe this is due to it keeping a change history for 30 days. I reduced this to 1 day to keep file size low.

There are no extra users any longer in the shared user list and the files are functioning great.

Update: 9/17/15 The files are remaining the same size the users have not noticed any performance declines. I have not had to do any work on the files to clean up bloat. This seems to have fixed the problems.

Update: 3/27/17 The original answer above worked well until we really started to push these workbooks. We now have about 150 users making thousands of changes to these workbooks every week it was at this point we started to have issues again.

So I added additional code to Unshare the workbooks weekly and then Reshare the workbook the first time they are opened on Sunday. This takes care of any other issues that might cause the workbook to become corrupt.

I added the final part about a year ago and since we have not had issues at all. Here is the final part of my code with comments to explain it. Just add this to a module and call the SundayMaintenance routine on the Workbook_Open Event:

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

Update: 7/23/18 I added smirkingman's small change to this answer. We are still running this code in our shared workbooks and they do not crash and are running as expected. We also run the latest SharePoint version which has still not caught up with the features of a shared workbook.

4
  • 1
    There's a subtle bug in your example. When you remove a user the array size changes so you should scan the users 'backwards': For UserCount = UBound(Users) To 1 Step -1 Jun 14, 2017 at 7:51
  • Wow, that is definitely pushing the limits of Excel, or even Access for that matter. Glad to hear it's working for you. We're looking into sharing some workbooks, but most reports about it is not that positive. Most people just say sharing is "broken," but if Microsoft put something like that in (perhaps with a prompt asking the user if they want to keep working and running that if not answered), perhaps it might actually be a useful feature! Sep 12, 2017 at 15:45
  • Yea it actually is working quite well now our company was going to switch to SharePoint but the features of SharePoint don't even compare to Sharing in Excel so we are sticking with my solution
    – Matt
    Sep 27, 2017 at 2:56
  • @smirkingman I have added your correction to the answer I had intended to do it awhile ago but I think I just forgot.
    – Matt
    Jul 23, 2018 at 17:47

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.