Avoid overwrite conflicts in excel shared workbook

Question

Some background: I built a shared workbook which suffered a lot of save conflicts from people adding items in new rows at the same time.

The process of adding a new row of information is done via a macro, so I've created a new version where the macro saves the workbook before adding the information, therefore stopping two sets of data being put into the same row.

My issue: Saving the file is really slowing down the macro because the file is about 2 MB.

My question: Is there a way of speeding up the save process, or maybe only updating the workbook with other people's changes to save time?

Edit #1

The macro file which update the shared sheet has another primary objective. Based on the data of an local excel file, we used the macro to generate a standard text for reporting.

Based on a flag in the shared workbook user check is the issue is already reported or not.

Also this macro is used by 4 or more people at the same time which results in the conflict.

Answer 1

It seems possible (not entirely clear) that preventing multiple users from running the macro simultaneously could help prevent the problem. Based on OP's comments above here is the code to achieve that. The code will check Windows processes to see if another instance of this macro is already running. Obviously, this check should be the first thing happening in the OP's script.

Option Explicit

Function RunningInstancesOfThisScript()
    Dim colProcesses
    Dim objProcess
    Dim lScriptCount


    RunningInstancesOfThisScript = 0

    lScriptCount = 0

    ' Get list of running processes using WMI
    Set colProcesses = GetObject("winmgmts:\\.\root\cimv2").ExecQuery("Select * From Win32_Process")

    For Each objProcess in colProcesses
        If (Instr(1, objProcess.Commandline, WScript.ScriptFullName, vbTextCompare) <> 0) Then
            lScriptCount = lScriptCount + 1
        End If
    Next

    RunningInstancesOfThisScript = lScriptCount 
End Function

Function IsThisScriptAlreadyRunning()
    Dim lScriptCount




    lScriptCount = RunningInstancesOfThisScript()

    If (lScriptCount < 1) Then
        ' This should not happen. There should be at least one instance, the current one
        IsThisScriptAlreadyRunning = False
    ElseIf (lScriptCount = 1) Then
        ' The current instance is the only one
        IsThisScriptAlreadyRunning = False
    Else
        IsThisScriptAlreadyRunning = True
    End If
End Function

If (IsThisScriptAlreadyRunning() = True) Then
    MsgBox "Another instance of this script is already running. This instance will now terminate without making any changes. Please try again after a few minutes.", vbExclamation
    WScript.Quit
Else
    MsgBox "There is no other instance of this script currently running. This instance will now proceed and make the changes needed.", vbInformation
End If

Another option is to check if the Excel file is already open. To run the following script, you'd need to replace <FileName> with a real file name.

Option Explicit

Function IsOfficeFileAlreadyOpen(strOfficeFileFullName)
    Dim lPos
    Dim strLockFileFullName



    lPos = InstrRev(strOfficeFileFullName, "\", -1, vbBinaryCompare)
    If (lPos = 0) Then
        ' Only file name has been given, no path specified. Must be in current folder. Good luck!
        strLockFileFullName = "~$" & strOfficeFileFullName
    Else
        strLockFileFullName = Left(strOfficeFileFullName, lPos) & "~$" & Mid(strOfficeFileFullName, lPos + 1)
    End If

    IsOfficeFileAlreadyOpen = CreateObject("Scripting.FileSystemObject").FileExists(strLockFileFullName)
End Function

If (IsOfficeFileAlreadyOpen("<FileName>") = True) Then
    MsgBox "The file '" & <FileName> & "' is already open. Please try again once the file is closed.", vbExclamation
    WScript.Quit
Else
    ' Open the file first
    MsgBox "The file '" & "<FileName>" & "' is available and will be processed.", vbInformation
End If

Both these solutions are susceptible to race conditions.