Efficiently copy and paste block of cells based on multiple criteria

I have a large data set and want to query to columns based on a set of criteria to another sheet. I have a working method that uses a loop to find the start and a loop to find the end to get the rows required, but this is slow.

I want to avoid a unique column that's required for the find function as this makes the end of the data tricky to find. I've considered trying to use some kind of FindAll function, but can't seem to figure out how to start it.

I've seen a lot about filters, but these seem to work by copying the whole row, which I want to avoid.

Like I said, this code works perfectly but it's way to slow as it will be run 1000's of times during a model run. I also have several similar subs that I'm hoping to able to roll the solution over

Sub Join(CI, FI, FSD)
Dim a, b, LastRow As Long

LastRow = Fcst_Cust.Range("a1048576").End(xlUp).Row + 1

'find all values for that customer ID for dates greater than the forecast start date and copy onto forecast tab.

    a = 3
    b = 2

    Do Until ((Raw_IFcst.Cells(b + 1, 2) = CI) And (Raw_IFcst.Cells(b + 1, 3) >= FSD))
        a = a + 1
        b = b + 1
    Loop
    Do Until Raw_IFcst.Cells(b + 1, 2) <> CI
        b = b + 1
    Loop

    Raw_IFcst.Range("A" & a & ":AZ" & b).Copy
        Fcst_Cust.Range("C" & LastRow).PasteSpecial xlPasteValues
    Raw_IFcst.Range("BB" & a & ":CW" & b).Copy
        Fcst_Cust.Range("BG" & LastRow).PasteSpecial xlPasteValues

End Sub

Solution

It is likely that the AdvancedFilter method of the Range object will be the most efficient... and it definitely does not need to copy full rows. You can choose which columns you want.

However, I refactored your code, without utilizing the AdvancedFilter. This should be significantly quicker:

Sub Join_(CI, FI, FSD)
    Dim a&, b&, LastRow&, v

    LastRow = Fcst_Cust.[a1048576].End(xlUp).Row + 1

    a = 3
    b = 2

    With Raw_IFcst
        v = .Cells(1, 2).Resize(.[b1048576].End(xlUp).Row, 2).Value2

        Do
            If If v(b + 1, 1) = CI Then
                If v(b + 1, 2) >= FSD Then
                    Exit Do
                End If
            End If
            a = a + 1
            b = b + 1
        Loop

        Do Until v(b + 1, 1) <> CI
            b = b + 1
        Loop

        .Range("A" & a & ":AZ" & b).Copy
            Fcst_Cust.Range("C" & LastRow).PasteSpecial xlPasteValues

        .Range("BB" & a & ":CW" & b).Copy
            Fcst_Cust.Range("BG" & LastRow).PasteSpecial xlPasteValues
    End With

End Sub

Note: I have not tested this, so please do.

Note: I have changed the name of the Sub. It is not a good practice to use the name of an existing VBA function as the name of the procedure, unless you truly wish to override that function.

Note: I changed the Dim line. You had a and b as variants, when they should be longs.

Note: What was slowing down your procedure the most was the cell-by-cell read through columns 2 and 3. Reading and writing to cells one at a time is perhaps the most inefficient process available to an Excel developer. What my code does is transfer the used portion of columns 2 and 3 into an array, v. This is very fast and accessing the individual elements of the array as opposed to individual cells is extremely fast.

Note: I changed the first Do While loop. VBA expression evaluation does not short-circuit multiple clauses. So, if clause 1 And clause 2 must be true (as in your case) then clause 2 will get evaluated EVEN WHEN clause 1 is false. That is a waste of processing with zero benefit. In your original setup that waste was amplified because of the slow read of individual cells. The optmization is to break up the clauses into separate lines. This way if the first fails, the second is never evaluated. This notion can be further otpimized by placing the clause that is most likely to fail on the first line. I do not know which is most likely to fail in your scenario, so I placed your first clause on the first line.