Help with a duplication error VBA Code

[brett1again]

Hello,
I'm needing some help figuring out a duplication error I'm getting when trying to run essentially the same code on 2 separate sheets within the same workbook. Could someone take a look and let me know what I'm doing wrong or need to change?

"Completed" sheet code:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Oldvalue As String

Dim Newvalue As String

Dim xRng As Range

Dim Lastrow As Long



If Target.Count > 1 Then Exit Sub



On Error GoTo Exitsub

Set xRng = Range("U:U").SpecialCells(xlCellTypeAllValidation)

On Error GoTo 0



If Not Application.Intersect(Target, xRng) Is Nothing Then



Application.EnableEvents = False



Newvalue = Target.Value

Application.Undo

Oldvalue = Target.Value

Target.Value = Newvalue



If Oldvalue <> "" Then

If Newvalue <> "" Then



If Oldvalue = Newvalue Or _

InStr(1, Oldvalue, ", " & Newvalue) Or _

InStr(1, Oldvalue, Newvalue & ",") Then

Target.Value = Oldvalue

Else

Target.Value = Oldvalue & ", " & Newvalue

End If



End If

End If



Application.EnableEvents = True



End If



'********Delete record

If Not Intersect(Target, Range("AD:AD")) Is Nothing Then

If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub

Dim Lastrow As Long

Lastrow = Sheets("BURIAL TRACKER").Cells(Rows.Count, "AD").End(xlUp).Row + 1



If Target.Value = "RETURN" Then

Rows(Target.Row).Copy Destination:=Sheets("BURIAL TRACKER").Rows(Lastrow)

Rows(Target.Row).Delete

End If

End If

End Sub[CODE=vba]

[/CODE]
"Burial Tracker" sheet code:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Oldvalue As String
  Dim Newvalue As String
  Dim xRng As Range
  Dim Lastrow As Long
  
  If Target.Count > 1 Then Exit Sub
  
  On Error GoTo Exitsub
  Set xRng = Range("U:U").SpecialCells(xlCellTypeAllValidation)
  On Error GoTo 0
  
  If Not Application.Intersect(Target, xRng) Is Nothing Then
  
    Application.EnableEvents = False
    
    Newvalue = Target.Value
    Application.Undo
    Oldvalue = Target.Value
    Target.Value = Newvalue
    
    If Oldvalue <> "" Then
      If Newvalue <> "" Then
      
        If Oldvalue = Newvalue Or _
          InStr(1, Oldvalue, ", " & Newvalue) Or _
          InStr(1, Oldvalue, Newvalue & ",") Then
          Target.Value = Oldvalue
        Else
          Target.Value = Oldvalue & ", " & Newvalue
        End If
        
      End If
    End If
        
    Application.EnableEvents = True
    
  End If
  
  '********Delete record
  If Not Intersect(Target, Range("AD:AD")) Is Nothing Then
    If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
    Lastrow = Sheets("COMPLETED").Cells(Rows.Count, "AD").End(xlUp).Row + 1
    
    If Target.Value = "CLOSE" Then
      Rows(Target.Row).Copy Destination:=Sheets("COMPLETED").Rows(Lastrow)
      Rows(Target.Row).Delete
    End If
  End If

Exitsub:
End Sub

 

[StephenCrump]

You didn't give any details, but I assume this is the error you're referring to?

You have the same declaration twice in the "Completed" sheet module.

It also looks like you're missing an "ExitSub:" label at the end of the Sub?

 

[brett1again]

Yes, that's the error I'm getting. I'm not seeing where the declaration is twice in the "completed" sheet? The code I used on the "burial tracker" sheet allowed me to move the row over to the "completed" sheet which worked fine. If the row was moved accidentally I then needed the ability to move the row back from the "completed" to "burial tracker" reversing the same code. That's when I got the error. What should I change to make it work?

 

[StephenCrump]

The code I used on the "burial tracker" sheet allowed me to move the row over to the "completed" sheet which worked fine. If the row was moved accidentally I then needed the ability to move the row back from the "completed" to "burial tracker" reversing the same code. That's when I got the error.

This is a compile error. The code hasn't started running, so we don't know yet whether it will work, or whether the logic is correct.

The error simply means that you have declared the variable LastRow more than once inside this Sub. In the code you originally posted, you had:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Oldvalue As String
    Dim Newvalue As String
    Dim xRng As Range
    Dim Lastrow As Long

'......

'********Delete record
    If Not Intersect(Target, Range("AD:AD")) Is Nothing Then
        If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
        Dim Lastrow As Long

'......

 

[brett1again]

Just saw that duplication, thanks for pointing that out!