none
Combining 2 worksheet changes RRS feed

  • Question

  • I need to combine the 2 following worksheet changes. I am not that experienced and cannot figure it out

    Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column <> 8 Or Target.Cells.Count > 1 Then Exit Sub
    Dim SortRange As Range
    Set SortRange = Range(("A1"), Cells(Rows.Count, 8).End(xlUp))
    SortRange.Sort Key1:=Range("H2"), Order1:=xlAscending, Header:=xlYes
    End Sub

    Private Sub Worksheet_Change(ByVal Target As Range)
      Dim C As Range
      If Intersect(Target, Me.Range("D:D")) Is Nothing Then Exit Sub
      For Each C In Intersect(Target, Me.Range("D:D")).Cells
        If C.Text = "y" Then
          C.EntireRow.Copy Worksheets("Shipped").Cells(Rows.Count, "D").End(xlUp).Offset(1).EntireRow
          C.EntireRow.Delete
        End If
      Next
    End Sub

    Tuesday, November 8, 2016 4:28 PM

All replies

  • You basically wrap each one in a conditional, reversing the conditions use to Exit Sub

    For example:

        If Target.Column <> 8 Or Target.Cells.Count > 1 Then Exit Sub

    becomes

        If Target.Column = 8 And Target.Cells.Count = 1 Then

    (It could also have been:

       If Not  (Target.Column <> 8 Or Target.Cells.Count > 1 ) Then

    but I don't like that logic as much because it is harder to read / understand.)

    So, all together, we use:

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim C As Range
        Dim SortRange As Range

        If Target.Column = 8 And Target.Cells.Count = 1 Then
            Set SortRange = Range(("A1"), Cells(Rows.Count, 8).End(xlUp))
            SortRange.Sort Key1:=Range("H2"), Order1:=xlAscending, Header:=xlYes
        End If

        If Not Intersect(Target, Me.Range("D:D")) Is Nothing Then
            For Each C In Intersect(Target, Me.Range("D:D")).Cells
                If C.Text = "y" Then
                    C.EntireRow.Copy Worksheets("Shipped").Cells(Rows.Count, "D").End(xlUp).Offset(1).EntireRow
                    C.EntireRow.Delete
                End If
            Next
        End If
    End Sub

    You should also note that VBA is case sensitive - so you may want to change

     If C.Text = "y" Then

    to

     If LCase(C.Text) = "y" Then

     
    Tuesday, November 8, 2016 5:59 PM