Macro to copy and paste rows with correct first cell

Question

I have a spreadsheet with lots of sheets and data, the first cell of each row always being a date. I have made a control sheet (Control CUSTOM), where user types two dates into cells B3 and C3, and then the macro would search all the sheets in the workbook for rows having first cell value BETWEEN these dates, then copy and paste the rows to the summary sheet (Data CUSTOM).

Yet it doesn't work as intended. The macro manages to find correct rows, and copy them, but it pastes it always to the same row, therefore overwriting itself. It also pastes them to wrong sheet (Control CUSTOM).

So far my code looks like this:

Sub DataSearch()
    Dim lngLastRow As Long, lngRow As Long
    Dim strColumn As String
    Dim WS_Count As Integer
    Dim I As Integer
    Dim NextRow As Variant
    Dim Date1 As Variant
    Dim Date2 As Variant


    Date1 = Sheets("Control CUSTOM").Range("B3")
    Date2 = Sheets("Control CUSTOM").Range("C3")


' Set correct row for paste, always the next empty row



' Set WS_Count equal to the number of worksheets in the active workbook.
WS_Count = ActiveWorkbook.Worksheets.Count

' Begin the loop.
For I = 1 To WS_Count

    strColumn = "A"
    With ActiveWorkbook.Worksheets(I)
        lngLastRow = .Cells(.Rows.Count, strColumn).End(xlUp).Row
        For lngRow = 2 To lngLastRow
        Set NextRow = Range("A" & Sheets("Data CUSTOM").UsedRange.Rows.Count + 1)
        If IsDate(.Cells(lngRow, strColumn).Value) And .Cells(lngRow, strColumn).Value >= Date1     And .Cells(lngRow, strColumn).Value <= Date2 Then
            .Rows(lngRow).Copy
            NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
        Application.CutCopyMode = False


        End If
        Next lngRow
    End With
    Next I
End Sub

Hope you guys can help me. I have some experience with VBA, but all these multiple loops this propably needs just goes way over my head.

Answer 1

If you address these two issues with your NextRow range variable your code should be ok.

For performance you might want to consider autofiltering the rows and copying in a block rather than testing line by line.

You also might want to exclude your two control sheets from the macro for good coding practice.

Dim NextRow As Variant
to
Dim NextRow As Range

and change
NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
to
Set NextRow = Sheets("Data Custom").Range("A" & Sheets("Data CUSTOM").UsedRange.Rows.Count + 1)

Answer 2

As brettdj mentioned, to fix this issue you should add

Sheets("Data Custom").

to

Set NextRow = Range("A" & Sheets("Data CUSTOM").UsedRange.Rows.Count + 1)

so that it reads:

Set NextRow = Sheets("Data Custom").Range("A" & Sheets("Data CUSTOM").UsedRange.Rows.Count + 1)

By adding Sheets("Data Custom"). you are telling the macro that this range is NOT on the current worksheet (with is the inherent assumption).

Also, I'd recommend a couple of additional tweaks:

For Best Practices/Potential Issues

• Use ThisWorkbook instead of ActiveWorkbook to ensure that you haven't accidentally activated another workbook
• Try not to use the .UsedRange property...EVER. It's much more preferable to either increment a counter as you go or to do something similar to what you did earlier with lngLastRow = .Cells(.Rows.Count, strColumn).End(xlUp).Row. The reason for this is because Excel defines the .UsedRange based on things like formatting and the biggest range that has ever been used. As such, if you had a bunch of values in a range, and then cleared the values from the last row, it would still be considered part of the used range.
• I would suggest changing Dim NextRow As Variant to Dim NextRow As Range since NextRow is always a Range object and doesn't vary. (courtesy of brettdj)
• You also might want to exclude your two control sheets from the loop so that you're not evaluating them throughout the process. This could lead to potential issues (courtesy of brettdj)

For Performance

• For performance you might want to consider autofiltering the rows and copying in a block rather than testing line by line. (courtesy of brettdj)

• Add the following code to the beginning of your method (after getting the date values):

  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  

  And right before the end of the sub:

  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  

  This tells Excel to stop SHOWING the changes that it's making to the workbook and to stop updating/calculating any formulas until after it's done running the macro. This will be a huge performance gain.