range.rows.count不在循环更新

Question

Intended functionality is: for each item in list A, scan list B and identify matches. Add these matches to a range, which is then output if the match count is > 0.

This works perfect the first time though the loop, but on all further iterations, while WorkRng is added to properly (I can output it to a cell and it has all the data), WorkRng.Rows.Count remains at 1.

Dim pasteRng as Range
Dim WorkRng as Range

For i = 2 To LastRow

Set WorkRng = Sheets("Output").Range("A1:G1")


    For j = 2 To outputCount
            If Worksheets("Output").Cells(j, 8).Value = Worksheets("Vendor List").Cells(i, 1).Value Then 'this line correctly identifies matches on subsequent loops
                Set pasteRng = Sheets("Output").Range("A" & j & ":G" & j) 
                Set WorkRng = Union(WorkRng, pasteRng) 'this line does not increase WorkRng.Rows.Count except on the first loop
            End If
    Next j



If WorkRng.Rows.Count > 1 Then

'do some stuff

End If


Set pasteRng = Nothing
Set WorkRng = Nothing

Next i

I would appreciate any guidance.

Answer 1

If you skip rows you end up with a multi-area (non-contiguous) range, so by default Rows.Count will only return the number of rows in the first Area (ie. 1)

In the Immediate pane:

? Range("$A$1:$C$1,$A$3:$C$3").Rows.Count
>> 1

You could update your If check:

If WorkRng.Cells.Count > 6 Or  Then

'do some stuff

End If

Answer 2

You can this generic function to count rows from any range (both contiguous and non-contiguous):

Function GetRowsCount&(rng As Range)
    Dim rngArea As Range
    For Each rngArea In rng.Areas
        GetRowsCount = GetRowsCount + rngArea.Rows.Count
    Next
End Function