Concurrent Saving of shared Excel Files

[Revs90]

Hell all,
This is my very first post here. I have a beginner's experience in Excel and I have encountered an issue that I wasn't able to find a solution for online.
I am using a shared excel file that is a data entry form shared by 12 users. Each person gets in, fills information and hits a command button that saves this data to an external excel file that is shared as well and named “Database”. Then the form is cleared of the user-input data and the operation is complete. The command button has a macro that will paste the data by invisibly manipulating the Database file, saving it and closing it. The process is working great except when two people hit the command button at the same instant (which saves the external file and causes concurrent saving), at which point the Macro has a fatal error that read “File locked”. This ends up having the user-input cleared out but not saved.
What I am looking for is either an errorhandler that would catch the error and delay saving for a couple seconds, or at least an exception type thing that does not clear the data and shows some kind of message to the user that the data was not sent to the database (wasn’t saved).

This is the entire script I have:

Sub UpdateWorksheet()
    Dim historyWks As Worksheet
    Dim inputWks As Worksheet
 
    Dim nextRow As Long
    Dim oCol As Long
 
    Dim myRng As Range
    Dim myCopy As String
    Dim myCell As Range
    Dim xl0 As New Excel.Application
    Dim xlw As New Excel.Workbook
    Set xlw = xl0.Workbooks.Open("C:\Auto Show\Database.xlsx")
    xl0.Worksheets("Sheet1").Select
   
    myCopy = "F6,F8,F10,F12,F14"
 
    Set inputWks = Worksheets("Input")
    Set historyWks = xlw.Worksheets("Sheet1")
 
    With historyWks
        nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    End With
 
    With inputWks
        Set myRng = .Range(myCopy)
 
        If Application.CountA(myRng) <> myRng.Cells.Count Then
            MsgBox "Please fill in all the cells!"
            Exit Sub
        End If
    End With
 
    On Error GoTo ErrorHandler
   [B][U] xlw.SaveUB [/U][/B]ß This is the part I suspect is causing the issue
    Exit Sub
    ErrorHandler
    xlw.Save
    Application.Wait (Now + TimeValue("00:00:04"))
    Resume Next
    xlw.Close
    Set xl0 = Nothing
    Set xlw = Nothing
    On Error GoTo 0
 
      With inputWks
               With .Range(myCopy).Cells
              .ClearContents
              Application.GoTo .Cells(1) ', Scroll:=True
         End With
      On Error GoTo 0
    End With
End Sub

Any help is appreciated. Thank you very much in advance
P.S. I am using Excel 2010
P.P.S. This is the first time I work with error handing scripts

 

[ranman256]

Sub UpdateWorksheet()
    Dim historyWks As Worksheet
    Dim inputWks As Worksheet
 
    Dim nextRow As Long
    Dim oCol As Long
 
    Dim myRng As Range
    Dim myCopy As String
    Dim myCell As Range
    Dim xl0 As New Excel.Application
    Dim xlw As New Excel.Workbook
    
    Set xlw = xl0.Workbooks.Open("C:\Auto Show\Database.xlsx")
    xl0.Worksheets("Sheet1").Select
      
    myCopy = "F6,F8,F10,F12,F14"
 
    Set inputWks = Worksheets("Input")
    Set historyWks = xlw.Worksheets("Sheet1")
 
    With historyWks
        nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    End With
 
    With inputWks
        Set myRng = .Range(myCopy)
 
        If Application.CountA(myRng) <> myRng.Cells.Count Then
            MsgBox "Please fill in all the cells!"
            Exit Sub
        End If
    End With
 
    On Error GoTo ErrorHandler
    xlw.SaveUB    ' This is the part I suspect is causing the issue
    
      With inputWks
               With .Range(myCopy).Cells
              .ClearContents
              Application.Goto .Cells(1) ', Scroll:=True
         End With
      On Error GoTo 0
    End With
    
endit:
    Set xl0 = Nothing
    Set xlw = Nothing
    xlw.Close
Exit Sub
ErrorHandler:
MsgBox Err.Description, , Err   'check for the FILE LOCKED ERR HERE
'If Err = 999 Then              'chg 999 to the FILE LOCKED ERR#
    xlw.Save
    Application.Wait (Now + TimeValue("00:00:04"))
    Resume Next
'End If
End Sub

 

[Revs90]

Thank you so much for the fast response. I am going to test it out with a collegue later today and post back what results I get. Thanks again!

 

[Revs90]

Hello ranman,
So I tried the fix you suggested but when I run the macro, it shows the following error:
“Run-time error 429
ActiveX component can’t create object”
Can you please help me overcome this?

I will be grateful.
Thanks