Accept saved changes in shared book - vba

[filarap]

Hi all,

I am creating a file that will be shared between different users. They will be using input form and when button is clicked, it will fill in the next row with data. This all works fine, however i am having difficulties with shared enviroment.

Currently the code is first doing the save, then executing macro abd then saving again.
How it works is that after button click, it pulls "accept other changes" window and when clicked it put success message (msgbox created).
Howewer next row remains empty.

I tried googling solutions and searching this forum with no success.

Anyone know a way to achieve this?
Thank you

 

[filarap]

And here is what i have so far

Hi all,

Sub copifromform()
With ThisWorkbook
If .MultiUserEditing Then
.AcceptAllChanges
.Save
End If
End With


If Sheet4.Range("d6").Value = "test" Then


If Sheet4.Range("d5").Value = "" Or Sheet4.Range("d6").Value = "" Or Sheet4.Range("d7").Value = "" _
Or Sheet4.Range("d8").Value = "" Or Sheet4.Range("d9").Value = "" Or Sheet4.Range("a11").Value = "" _
Or Sheet4.Range("f8").Value = "" Then
MsgBox ("Data missing")
Else


Sheet1.Range("b" & Rows.Count).End(xlUp).Offset(1, 0).Value = Sheet4.Range("d6").Value
Sheet1.Range("b" & Rows.Count).End(xlUp).Offset(0, 2).Value = Sheet4.Range("f8").Value
Sheet1.Range("b" & Rows.Count).End(xlUp).Offset(0, 1).Value = Sheet4.Range("d8").Value
Sheet1.Range("b" & Rows.Count).End(xlUp).Offset(0, 3).Value = Sheet4.Range("d7").Value
Sheet1.Range("b" & Rows.Count).End(xlUp).Offset(0, 6).Value = Sheet4.Range("d5").Value
Sheet1.Range("b" & Rows.Count).End(xlUp).Offset(0, 9).Value = Sheet4.Range("d9").Value
Sheet1.Range("b" & Rows.Count).End(xlUp).Offset(0, 10).Value = Sheet4.Range("a11").Value
Range("D5:I5").Select
Selection.ClearContents
Range("D6:I6").Select
Selection.ClearContents
Range("D7:I7").Select
Selection.ClearContents
Range("D8:E8").Select
Selection.ClearContents
Range("F8:I8").Select
Selection.ClearContents
Range("D9:F9").Select
Selection.ClearContents
Range("A11:I16").Select
Selection.ClearContents
MsgBox ("Entry succesful")


End If


'2
Else
If Sheet4.Range("d5").Value = "" Or Sheet4.Range("d6").Value = "" Or Sheet4.Range("d7").Value = "" _
Or Sheet4.Range("d8").Value = "" Or Sheet4.Range("d9").Value = "" Or Sheet4.Range("a11").Value = "" Then
MsgBox ("Data missing")
Else


Sheet1.Range("b" & Rows.Count).End(xlUp).Offset(1, 0).Value = Sheet4.Range("d6").Value
Sheet1.Range("b" & Rows.Count).End(xlUp).Offset(0, 2).Value = Sheet4.Range("d6").Value
Sheet1.Range("b" & Rows.Count).End(xlUp).Offset(0, 1).Value = Sheet4.Range("d8").Value
Sheet1.Range("b" & Rows.Count).End(xlUp).Offset(0, 3).Value = Sheet4.Range("d7").Value
Sheet1.Range("b" & Rows.Count).End(xlUp).Offset(0, 6).Value = Sheet4.Range("d5").Value
Sheet1.Range("b" & Rows.Count).End(xlUp).Offset(0, 9).Value = Sheet4.Range("d9").Value
Sheet1.Range("b" & Rows.Count).End(xlUp).Offset(0, 10).Value = Sheet4.Range("a11").Value


Range("D5:I5").Select
Selection.ClearContents
Range("D6:I6").Select
Selection.ClearContents
Range("D7:I7").Select
Selection.ClearContents
Range("D8:E8").Select
Selection.ClearContents
Range("F8:I8").Select
Selection.ClearContents
Range("D9:F9").Select
Selection.ClearContents
Range("A11:I16").Select
Selection.ClearContents
MsgBox ("Entry succesful")
End If
End If


With ThisWorkbook
If .MultiUserEditing Then
.AcceptAllChanges
End If
.Save
End With


Thank you