Issue with Duplicate Const & Dim Changed As Range

Jaikobi

New Member
Hi,
Trying to get these two instances to run together but not sure how to simplify.
Can provide any more information if needed.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Changed As Range
    
    Const YesCol As String = "L" '
    
    Set Changed = Intersect(Target, Columns(YesCol))
    If Not Changed Is Nothing Then
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        With Intersect(ActiveSheet.UsedRange, Columns(YesCol))
            .AutoFilter Field:=1, Criteria1:="=YES"
            With .Offset(1).EntireRow
                .Copy Destination:=Sheets("ARCHIVED") _
                    .Range("A" & Rows.Count).End(xlUp).Offset(1)
                .Delete
                End With
            .AutoFilter
            End With
              Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
    
    Const YesCol As String = "K" '
    
    Set Changed = Intersect(Target, Columns(YesCol))
    If Not Changed Is Nothing Then
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        With Intersect(ActiveSheet.UsedRange, Columns(YesCol))
            .AutoFilter Field:=1, Criteria1:="=NO"
            With .Offset(1).EntireRow
                .Copy Destination:=Sheets("DELIVERED") _
                    .Range("A" & Rows.Count).End(xlUp).Offset(1)
                .Delete
                End With
            .AutoFilter
            End With
              Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
 
Last edited by a moderator:

Fluff

MrExcel MVP, Moderator
Hi & welcome to MrExcel
How about
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   
   If Not Intersect(Target, Columns("L")) Is Nothing Then
      Application.EnableEvents = False
      Application.ScreenUpdating = False
      With Intersect(Me.UsedRange, Columns("L"))
         .AutoFilter Field:=1, Criteria1:="=YES"
         With .Offset(1).EntireRow
            .Copy Destination:=Sheets("ARCHIVED") _
            .Range("A" & Rows.Count).End(xlUp).Offset(1)
            .Delete
         End With
         .AutoFilter
      End With
      Application.EnableEvents = True
      Application.ScreenUpdating = True
   ElseIf Not Intersect(Target, Columns("K")) Is Nothing Then
      Application.EnableEvents = False
      Application.ScreenUpdating = False
      With Intersect(Me.UsedRange, Columns("K"))
         .AutoFilter Field:=1, Criteria1:="=NO"
         With .Offset(1).EntireRow
            .Copy Destination:=Sheets("DELIVERED") _
            .Range("A" & Rows.Count).End(xlUp).Offset(1)
            .Delete
         End With
         .AutoFilter
      End With
      Application.EnableEvents = True
      Application.ScreenUpdating = True
   End If
End Sub
 

Some videos you may like

This Week's Hot Topics

Top