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(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 'strange... It looks to stay better after the next code line...
Next y
'Next x is missing, too...
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 to adjust to a Shared workbook would be great. The rows 10 to 19 only contain the data i am manupulating (sorting)
As a result, you should end up with code like this:
Option Explicit
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
'Next x is missing, too...
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
End If
Application.CutCopyMode = False
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub