Intersection Error with Multiple VBA Loops

I'm trying to write a code to move rows into separate sheets based on input, I have it working for one case as shown below:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim C As Range
If Intersect(Target, me.Range("AN:AN")) Is Nothing Then Exit Sub
For Each C In Intersect(Target, me.Range("AN:AN")).Cells
   If C.Text "Y" Then
     C.EntireRow.Copy Worksheets("Closed").Cells(Rows.Couint, "AN").End(xlUp).Offset(1).EntireRow
     C.EntireRow.Delete
   End If
   Next
End Sub

Now I want to have a seperate case for a seperate column reference but when I try and repeat the code into the same subroutine I get an error '1004 intersect error', I have tried quite a few things but the error seems to always be thrown with the second intersect statement:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim C, B As Range
If Intersect(Target, me.Range("AN:AN")) Is Nothing Then Exit Sub
For Each C In Intersect(Target, me.Range("AN:AN")).Cells
   If C.Text "Y" Then
     C.EntireRow.Copy Worksheets("Closed").Cells(Rows.Count, "AN").End(xlUp).Offset(1).EntireRow
     C.EntireRow.Delete
   End If
   Next
If Intersect(Target, me.Range("D:D")) Is Nothing Then Exit Sub
For Each B In Intersect(Target, me.Range("D:D")).Cells
   If B.Text "Q" Then
     B.EntireRow.Copy Worksheets("Quoted").Cells(Rows.Count, "D").End(xlUp).Offset(1).EntireRow
     B.EntireRow.Delete
   End If
   Next
End Sub

I tried to group the two presence checks into one statement at the start but it still threw an error during the second loop, as shown:

    If Intersect(Target, me.Range("AN:AN, D:D")) Is Nothing Then Exit Sub

1 answer

  • answered 2020-07-05 00:48 Variatus

    My intention is to show you an approach, not to give you a working solution. Here is the approach.

    Private Sub Worksheet_Change(ByVal Target As Range)
        
        Dim Rng         As Range            ' Action range
        Dim Cell        As Range            ' loop
        Dim Crit        As String           ' selection criterium
        Dim Ws          As Worksheet        ' Worksheet to copy to
        Dim C           As Long             ' Target column
        
        ' Columns("D") = Columns(4), "AN" = Columns("AN").Column [=40]
        Set Rng = Intersect(Target, Application.Union(Columns("D"), Columns("AN")))
        If Not Rng Is Nothing Then
            C = Target.Column
            Crit = IIf(C = 4, "Quoted", "Closed")       ' Columns("D") = Columns(4)
            Set Ws = Worksheets(Crit)
            Crit = IIf(C = 4, "Q", "Y")
            
            For Each Cell In Rng.Cells
                With Ws
                    If Cell.Value = Crit Then
                        Cell.EntireRow.Copy .Cells(.Rows.Count, C).End(xlUp).Offset(1).EntireRow
                        Cell.EntireRow.Delete
                    End If
                End With
            Next Cell
        End If
    End Sub
    

    And here is what's wrong with the code.

    1. Your loop looks at each cell in the range at the intersection of your columns and the change area. Most of the time the change will occur in only one cell, and that's fine. But if you paste a number of cells then Target comprises all the intersecting cells. Say, you paste to an area A3:F20, the intersecting area will be D3:D20 and each of those cells will be processed. That's fine, too - if you are aware of it.
    2. The For .. Each loop will process the cells in the sequence they inherit from their location on the sheet. In my above example, D3 will be processed first. When row 3 is deleted the rows below it move up. All the following deletions will therefore occur in the wrong row. Therefore you can't use For .. Each in that case. Instead you must start at the last cell, moving up to the first, and changes in row numbers will occur only below the new deletion where they don't matter. So, you should use For R = [Last row in Rng] to [First row in Rng] Step -1
    3. .Cells(.Rows.Count, C) Observe the leading periods before "Cells" and "Rows". The rows count must be taken in the same worksheet where the Cells range is located. But why do you determine the next row in column C (meaning D or AN)? The answer is because all columns have the same length. But logically, that should cause you to measure the length in column A. Which brings me to my last point.
    4. I have never seen this construct before: Cell.EntireRow.Copy .Cells(.Rows.Count, C).End(xlUp).Offset(1).EntireRow. I presume that it actually works (I didn't test) but the Destination would normally be a single cell. The single and correct cell emerging logically from your code is in column A. So, why do you go to some length to find the last cell in either column D or AN whereas all the while you really need the cell in column A? Cell.EntireRow.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1) should serve you equally well.