Help Combining 2 Private Sub Worksheet_Change(ByVal Target As Range) Codes

[brett1again]

Hello,
I'm trying to combine 2 worksheet_change codes and I can't seem to get it figured out. I'd really appreciate some help.

Here are the 2 codes separately:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Not Intersect(Target, Range("U:U")) Is Nothing Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & ", " & Newvalue
Else:
Target.Value = Oldvalue
End If
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
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("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
End Sub

Hope it's not to much to ask but once I get these combined I was also needing to add a code that piggybacks the move row/delete row code above. The code above moves the row from sheets"Tracker" to sheets"completed" when "close" is selected and then deletes it from sheets"tracker". I'd like to be able to move the row back to its original position if it was closed in error by selecting "return" in the same AD column. I've tried to create the code but I'm a definite novice when it comes to VBA and thought I'd ask for some help. Thanks in advance for the help!

 

[DanteAmor]

Hi and welcome to MrExcel!

I'd like to be able to move the row back to its original position if it was closed in error by selecting "return" in the same AD column.

You could not select "return" from the deleted record, simply because it no longer exists.
You should put the code in the "COMPLETED" sheet, there select the record that you want to return to the "tracker" sheet.

If you want it back in the same position, then when you copy it from the "tracker" sheet to the "COMPLETED" sheet, you must put in some column of that record the original row number, that way you can return it to its original row.

---------------

I'm trying to combine 2 worksheet_change codes

I give you the combined codes:

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

 

[DanteAmor]

In future please use code tags when posting code. How to Post Your VBA Code it makes your code easier to read andcopy and it also maintains VBA formatting.

 

[brett1again]

Hi and welcome to MrExcel!


You could not select "return" from the deleted record, simply because it no longer exists.
You should put the code in the "COMPLETED" sheet, there select the record that you want to return to the "tracker" sheet.

If you want it back in the same position, then when you copy it from the "tracker" sheet to the "COMPLETED" sheet, you must put in some column of that record the original row number, that way you can return it to its original row.

---------------


I give you the combined codes:

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

That worked great! Really appreciate your help...thanks

 

[brett1again]

In future please use code tags when posting code. How to Post Your VBA Code it makes your code easier to read andcopy and it also maintains VBA formatting.

I'll do that, thanks for the tip

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[brett1again]

Hope you don't mind but I discovered a error and thought I'd ask for your help again. The code you gave me works great. I went ahead and added a new code to the "completed" sheet that will return the row back to the top row in the "tracker" sheet (actually the 2nd row because the 1st row is frozen), moving everything else done one to make room. It works fine but I have a sumproduct formula in one of the columns that's erroring after the row is returned. I'm not sure if it's the formula or the code? Can you give me your thoughts?

Here is the formula:

=SUMPRODUCT(ISNUMBER(SEARCH('Formatting Lists'!$A$1:$A$11,'Burial Tracker'!$U2))*'Formatting Lists'!$B$1:$B$11)+IF($V2>250,($V2-250)*1.5,0)+($W2*8.5)

Here is the code:

Private Sub Worksheet_Change(ByVal Target As Range)
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

 

[DanteAmor]

This does not correspond to the original requirement. You must create a new thread.

 

[brett1again]

This does not correspond to the original requirement. You must create a new thread.

Will do