Correcting one code causes another to not work at all.

[PerryK]

I am working on a document in which clickable cells place different values in column M on sheets 1 and 3. On sheet 1 when column M reads COMPLETE it will be cut from sheet 1 and pasted in sheet 2 when column M reads PARTIAL HOLD it will be cut from sheet 1 and pasted into sheet 3. I am having many problems with this but the problem I am asking for help on here is that in the following code the moves will work but i get a "run-time error '424' Object Required" and is not accepting Time as an object in my line of code Target.Offset(, 4).Value = Time but when I fix the issue in the code for the clickable cells the rows will no longer cut and paste.

This first code is the code that allows the rows to move but gets me an error

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDest As Range, rngDest2 As Range, rngDest3 As Range
     If UCase(Target.Value) = "PARTIAL HOLD" Then
        Set rngDest = Sheet3.Range("A5:Q5")
        If Not Intersect(Target, Sheet1.Range("M5:M290")) Is Nothing Then
            Application.EnableEvents = False
            Target.EntireRow.Cut
            rngDest.Insert Shift:=xlDown
            Target.EntireRow.Delete
            Application.EnableEvents = True
        End If
    ElseIf UCase(Target.Value) = "PROGRESSING" Then
        Set rngDest3 = Sheet1.Range("A5:Q5")
        If Not Intersect(Sheet3.Cells(Target.Row, Target.Column), Sheet3.Range("M5:M290")) Is Nothing Then
            Application.EnableEvents = False
            Target.EntireRow.Cut
            rngDest3.Insert Shift:=xlDown
            Target.EntireRow.Delete
            Application.EnableEvents = True
        End If
    ElseIf UCase(Target.Value) = "COMPLETE" Then
        Set rngDest2 = Sheet2.Range("A5:Q5")
        If Not Intersect(Target, Sheet1.Range("M5:M290")) Is Nothing Then
             Application.EnableEvents = False
             Target.EntireRow.Cut
             rngDest2.Insert Shift:=xlDown
             Target.EntireRow.Delete
             Application.EnableEvents = True
        End If
    End If
End Sub


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   If Target.Column = 11 Then
      Cancel = True
      Target.Offset(, 2).Value = "IN PROGRESS"
      Target.Offset(, 4).Value = Time
   ElseIf Target.Column = 12 Then
      Cancel = True
      Target.Offset(, 1).Value = "COMPLETE"
      Target.Offset(, 4).Value = Time
   ElseIf Target.Column = 14 Then
      Cancel = True
      Target.Offset(, -1).Value = "PARTIAL HOLD"
   End If
End Sub

The next code is the correction I have made to the clickable cells, but this stops the rows from cutting and pasting

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDest As Range, rngDest2 As Range, rngDest3 As Range
     If UCase(Target.Value) = "PARTIAL HOLD" Then
        Set rngDest = Sheet3.Range("A5:Q5")
        If Not Intersect(Target, Sheet1.Range("M5:M290")) Is Nothing Then
            Application.EnableEvents = False
            Target.EntireRow.Cut
            rngDest.Insert Shift:=xlDown
            Target.EntireRow.Delete
            Application.EnableEvents = True
        End If
    ElseIf UCase(Target.Value) = "PROGRESSING" Then
        Set rngDest3 = Sheet1.Range("A5:Q5")
        If Not Intersect(Sheet3.Cells(Target.Row, Target.Column), Sheet3.Range("M5:M290")) Is Nothing Then
            Application.EnableEvents = False
            Target.EntireRow.Cut
            rngDest3.Insert Shift:=xlDown
            Target.EntireRow.Delete
            Application.EnableEvents = True
        End If
    ElseIf UCase(Target.Value) = "COMPLETE" Then
        Set rngDest2 = Sheet2.Range("A5:Q5")
        If Not Intersect(Target, Sheet1.Range("M5:M290")) Is Nothing Then
             Application.EnableEvents = False
             Target.EntireRow.Cut
             rngDest2.Insert Shift:=xlDown
             Target.EntireRow.Delete
             Application.EnableEvents = True
        End If
    End If
End Sub


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.EnableEvents = False
On Error GoTo Xit:
   If Target.Column = 11 Then
      Cancel = True
      Target.Offset(, 2).Value = "IN PROGRESS"
      Target.Offset(, 4).Value = Time
   ElseIf Target.Column = 12 Then
      Cancel = True
      Target.Offset(, 1).Value = "COMPLETE"
      Target.Offset(, 4).Value = Time
   ElseIf Target.Column = 14 Then
      Cancel = True
      Target.Offset(, -1).Value = "PARTIAL HOLD"
   End If
Xit:
Application.EnableEvents = True
End Sub

What can I do to fix this?

 

[PerryK]

This problem was solved with the following code

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   If Target.Column = 11 Then
      Cancel = True
      Target.Offset(, 2).Value = "IN PROGRESS"
      Target.Offset(, 4).Value = Time
   ElseIf Target.Column = 12 Then
      Cancel = True
      Application.EnableEvents = False
      Target.Offset(, 1).Value = "COMPLETE"
      Application.EnableEvents = True
      Target.Offset(, 4).Value = Time
      Target.EntireRow.Cut
      Sheet2.Range("A5").EntireRow.Insert xlShiftDown
      Target.EntireRow.Delete
   ElseIf Target.Column = 14 Then
      Cancel = True
      Target.Offset(, -1).Value = "PARTIAL HOLD"
   End If
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
    If Not Intersect(Target, Range("M:M")) Is Nothing Then
        If UCase(Target.Value) = "COMPLETE" Then


        ElseIf UCase(Target.Value) = "PARTIAL HOLD" Then
            Target.EntireRow.Cut
            Sheet3.Range("A5").EntireRow.Insert xlShiftDown
            Target.EntireRow.Delete
        End If
    End If
End Sub