use Vba code in share workbook

[Nedasheikhi]

Hi,
I have a code for sorting and changing quantity in one cell happen something in other cell. this excel is used with some people at the same time. but code doesn't work. is there any solution for it?
this is my code
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 12 Or Target.Columns.Count > 1 Then _
If Target.Column <> 14 Or Target.Columns.Count > 1 Then _
If Target.Column <> 17 Or Target.Columns.Count > 1 Then _
Exit Sub
Worksheets("Sheet1").Unprotect Password:="4850"
Dim tmp As Variant
tmp = Cells(Target.Row, 17).Formula 'save contents
On Error GoTo Enable_Events
Application.EnableEvents = False
If Not Intersect(Target, Range("Q2:Q1000")) Is Nothing Then
If Cells(Target.Row, "G") <> 0 And Target < Cells(Target.Row, "G") Then
Target.Offset(1, 0).EntireRow.Insert
Range("A" & Target.Row & ":P" & Target.Row).Copy _
Destination:=Range("A" & Target.Row + 1 & ":Q" & Target.Row + 1)
Cells(Target.Row, "G").Offset(1, 0).Formula = "=" & Cells(Target.Row, "G").Address(False, False) & "-" & Target.Address(False, False)
End If
End If
Cells(Target.Row, 17) = "#$"
Range("A1").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes
Cells(Application.Match("#$", Columns(17), 0), 1).Select
Range("L1").Sort Key1:=Range("L1"), Order1:=xlAscending, Header:=xlYes
Cells(Application.Match("#$", Columns(17), 0), 12).Select
Range("N1").Sort Key1:=Range("N1"), Order1:=xlAscending, Header:=xlYes
Cells(Application.Match("#$", Columns(17), 0), 14).Select
Range("P1").Sort Key1:=Range("P1"), Order1:=xlDescending, Header:=xlYes
Cells(Application.Match("#$", Columns(17), 0), 16).Select
Cells(Selection.Row, 17) = tmp 'restore contents
Enable_Events:
Application.EnableEvents = True
Worksheets("Sheet1").Protect Password:="4850"
End Sub

 

[Colo]

Welcome to the board.
Sad to say, the code doesn't work on a shared workbook.
All we can do is, distribute an add-in with some code and then make it work when the shared workbook is available. To implement an event-driven add-in, need to use a class module. Have you made an add-in? And have you used class modules?

'Place those procedures in a Standard module

Dim c As New Class1

Sub Auto_Open()
    Application.OnTime Now + TimeSerial(0, 0, 2), "sample1"
End Sub

Sub sample1()
    c.setting ActiveSheet
End Sub

'Place those procedures in a class module named [Class1]

Public WithEvents sh As Worksheet

Sub setting(ByVal s As Worksheet)
    Set sh = s
End Sub

Sub sh_Change(ByVal Target As Range)
    If Target.Parent.Parent.Name <> "Book1.xlsx" Then Exit Sub 'change here to the name of the shared book
    If Target.Parent.Name <> "Sheet1" Then Exit Sub 'change here to the sheet name for event-driven
    
    If Target.Column <> 12 Or Target.Columns.Count > 1 Then _
       If Target.Column <> 14 Or Target.Columns.Count > 1 Then _
       If Target.Column <> 17 Or Target.Columns.Count > 1 Then _
       Exit Sub
    Worksheets("Sheet1").Unprotect Password:="4850"
    Dim tmp As Variant
    tmp = Cells(Target.Row, 17).Formula    'save contents
    On Error GoTo Enable_Events
    Application.EnableEvents = False
    If Not Intersect(Target, Range("Q2:Q1000")) Is Nothing Then
        If Cells(Target.Row, "G") <> 0 And Target < Cells(Target.Row, "G") Then
            Target.Offset(1, 0).EntireRow.Insert
            Range("A" & Target.Row & ":P" & Target.Row).Copy _
                    Destination:=Range("A" & Target.Row + 1 & ":Q" & Target.Row + 1)
            Cells(Target.Row, "G").Offset(1, 0).Formula = "=" & Cells(Target.Row, "G").Address(False, False) & "-" & Target.Address(False, False)
        End If
    End If
    Cells(Target.Row, 17) = "#$"
    Range("A1").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes
    Cells(Application.Match("#$", Columns(17), 0), 1).Select
    Range("L1").Sort Key1:=Range("L1"), Order1:=xlAscending, Header:=xlYes
    Cells(Application.Match("#$", Columns(17), 0), 12).Select
    Range("N1").Sort Key1:=Range("N1"), Order1:=xlAscending, Header:=xlYes
    Cells(Application.Match("#$", Columns(17), 0), 14).Select
    Range("P1").Sort Key1:=Range("P1"), Order1:=xlDescending, Header:=xlYes
    Cells(Application.Match("#$", Columns(17), 0), 16).Select
    Cells(Selection.Row, 17) = tmp    'restore contents
Enable_Events:
    Application.EnableEvents = True
    Worksheets("Sheet1").Protect Password:="4850"
End Sub

 

[Nedasheikhi]

Welcome to the board.
Sad to say, the code doesn't work on a shared workbook.
All we can do is, distribute an add-in with some code and then make it work when the shared workbook is available. To implement an event-driven add-in, need to use a class module. Have you made an add-in? And have you used class modules?

'Place those procedures in a Standard module

Dim c As New Class1

Sub Auto_Open()
    Application.OnTime Now + TimeSerial(0, 0, 2), "sample1"
End Sub

Sub sample1()
    c.setting ActiveSheet
End Sub

'Place those procedures in a class module named [Class1]

Public WithEvents sh As Worksheet

Sub setting(ByVal s As Worksheet)
    Set sh = s
End Sub

Sub sh_Change(ByVal Target As Range)
    If Target.Parent.Parent.Name <> "Book1.xlsx" Then Exit Sub 'change here to the name of the shared book
    If Target.Parent.Name <> "Sheet1" Then Exit Sub 'change here to the sheet name for event-driven
   
    If Target.Column <> 12 Or Target.Columns.Count > 1 Then _
       If Target.Column <> 14 Or Target.Columns.Count > 1 Then _
       If Target.Column <> 17 Or Target.Columns.Count > 1 Then _
       Exit Sub
    Worksheets("Sheet1").Unprotect Password:="4850"
    Dim tmp As Variant
    tmp = Cells(Target.Row, 17).Formula    'save contents
    On Error GoTo Enable_Events
    Application.EnableEvents = False
    If Not Intersect(Target, Range("Q2:Q1000")) Is Nothing Then
        If Cells(Target.Row, "G") <> 0 And Target < Cells(Target.Row, "G") Then
            Target.Offset(1, 0).EntireRow.Insert
            Range("A" & Target.Row & ":P" & Target.Row).Copy _
                    Destination:=Range("A" & Target.Row + 1 & ":Q" & Target.Row + 1)
            Cells(Target.Row, "G").Offset(1, 0).Formula = "=" & Cells(Target.Row, "G").Address(False, False) & "-" & Target.Address(False, False)
        End If
    End If
    Cells(Target.Row, 17) = "#$"
    Range("A1").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes
    Cells(Application.Match("#$", Columns(17), 0), 1).Select
    Range("L1").Sort Key1:=Range("L1"), Order1:=xlAscending, Header:=xlYes
    Cells(Application.Match("#$", Columns(17), 0), 12).Select
    Range("N1").Sort Key1:=Range("N1"), Order1:=xlAscending, Header:=xlYes
    Cells(Application.Match("#$", Columns(17), 0), 14).Select
    Range("P1").Sort Key1:=Range("P1"), Order1:=xlDescending, Header:=xlYes
    Cells(Application.Match("#$", Columns(17), 0), 16).Select
    Cells(Selection.Row, 17) = tmp    'restore contents
Enable_Events:
    Application.EnableEvents = True
    Worksheets("Sheet1").Protect Password:="4850"
End Sub

thanks for your quick answer
unfortunately, I never used class modules and I don't know how to use it.
Now I use your code, instead of mine, but the part of the code for inserting new roads and the sorting part doesn't work
what should am I do?

 

[RoryA]

You cannot change protection on a sheet in a shared workbook.

 

[Nedasheikhi]

You cannot change protection on a sheet in a shared workbook.

So, what should am I do for our multiuser at the same time in the excel?

 

[Colo]

Sorry I didn't see your code well. Some functions would be restricted in the shared book such as inserting ranges and deleting ranges.

Please have a look at About the shared workbook feature

About the shared workbook feature - Microsoft Support

Shared Workbooks is an older feature that has been replaced by co-authoring. This article explains the older feature, but we recommend using co-authoring instead.

support.microsoft.com

If you are able to cover it operationally, please try the following steps.

First, you need to create a new workbook for making it an add-in.
On VBE, press Alt+I and then C so that a class module will be inserted.
Name it Class1 (usually automatically inserted)
Then place procedures for [Class1]

Next, on VBE, press Alt+I and then M so that a standard module will be inserted.
Then place procedures for [standard module]
*change workbook name and worksheet name at the top of the procedure.

Save this workbook as an add-in. Select its extension as xlam when you save.

Then, make the add-in available from Files > Options > Add-ins by ticking.

After it's available, open the shared workbook then try.

 

[RoryA]

So, what should am I do for our multiuser at the same time in the excel?

Your realistic choices, assuming you can't upgrade to 365 and use collaboration instead, are to not share the workbook, or don't protect the sheets or otherwise use features unavailable in shared workbooks. As a general rule I would recommend never using shared workbooks.