Nedasheikhi
New Member
- Joined
- Aug 30, 2022
- Messages
- 3
- Office Version
- 2013
- Platform
- Windows
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
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