Cut Insert row based on cell value

[wildmanager]

I have been using the following for years. However I now need to use the Workbook in Shared mode, and i'm getting a 1004 error about: "Insert method of range failed."
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Dim wb As Workbook
Dim ws1 As Worksheet
Dim x As Integer
Dim y As Integer
Dim score As Long
Dim scoreRow As Long
Set wb = ActiveWorkbook
Application.EnableEvents = False
Application.ScreenUpdating = False
If Target.Column >= 2 And Target.Column <= 10 And Target.Row >= 5 And Target.Row <= 9 Then
Set ws1 = Worksheets(1)
For x = 10 To 19
score = ws1.Cells(x, 14).Value
scoreRow = x
For y = x + 1 To 19
If ws1.Cells(y, 14).Value > score Then
score = ws1.Cells(y, 14).Value
scoreRow = y
End If
Next y

If scoreRow <> x Then
ws1.Cells(scoreRow, 13).Cut
ws1.Cells(x, 13).Insert
ws1.Cells(scoreRow, 14).Cut
ws1.Cells(x, 14).Insert
End If
ActiveWorkbook.Save
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub


Any help would be appreciated.
The rows where the data is 10-19 contains no other data
Next x
End If
'If Not wb.MultiUserEditing Then
'ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, accessMode:=xlShared, ConflictResolution:=xlLocalSessionChanges
ActiveWorkbook.Save

'End If
Application.DisplayAlerts = False
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

 

[RoryA]

Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at:

Excel cut and insert based on a cell value

In a shared workbook I'm getting a 1004 error about: "Insert method of range failed." I have been using the following code for years. (Non shared mode) Private Sub Workbook_SheetChange(By...

stackoverflow.com

There is no need to repeat the link(s) provided above but if you have posted the question at other places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[RoryA]

That can't be your real code as it wouldn't compile. Anyway, you can't insert cells in a shared workbook - see the list of unavailable features here: About the shared workbook feature - Microsoft Support

 

[wildmanager]

My appologies.
I tryed to edit afterwards, but was unable tp.
New here, and it won't happen again.

Excel cut and insert based on a cell value

In a shared workbook I'm getting a 1004 error about: "Insert method of range failed." I have been using the following code for years. (Non shared mode) Private Sub Workbook_SheetChange(By...

stackoverflow.com

My code now looks like this.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Dim wb As Workbook
Dim ws1 As Worksheet
Dim x As Integer
Dim y As Integer
Dim score As Long
Dim scoreRow As Long
Set wb = ActiveWorkbook
Application.ScreenUpdating = False
Application.EnableEvents = False

If Target.Column >= 2 And Target.Column <= 10 And Target.Row >= 5 And Target.Row <= 9 Then
Set ws1 = Worksheets(1)

For x = 10 To 19
score = ws1.Cells(x, 14).Value
scoreRow = x

For y = x + 1 To 19

If ws1.Cells(y, 14).Value > score Then
score = ws1.Cells(y, 14).Value
scoreRow = y
End If 'strange... It looks to stay better after the next code line...

Next y

If scoreRow <> x Then
ws1.Cells(scoreRow, 13).Cut
ws1.Cells(x, 13).Insert
ws1.Cells(scoreRow, 14).Cut
ws1.Cells(x, 14).Insert
End If

ActiveWorkbook.Save
Next x
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub


Could it be adjusted to cut and insert whole rows? Nothing else is on those rows.

 

[wildmanager]

the problem isn't solved.
Apparently cut and inserting cells is not supported in shared mode.

therefore i would like help with this piece of script to move whole rows, rather than celles.

If scoreRow <> x Then
ws1.Cells(scoreRow, 13).Cut
ws1.Cells(x, 13).Insert
ws1.Cells(scoreRow, 14).Cut
ws1.Cells(x, 14).Insert
End If

hopefully there is a answer?