Copy rows within date range

[miyage]

Hi. Im a bit stuck on how to attack this problem in vba and im sure someone has a basic solution for this:

In Sheet1, I have A1: Start Date and A2: End Date
In Sheet2, is the look up sheet. Its sorted by ColumnA:
ColumnA.......ColumnB.....ColumnC...ColumnD
01/02/2008...James........20...........$200
05/02/2008...Jones .......10...........$800
06/02/2008...Mary.........30...........$900
06/02/2008...Bob...........50...........$600
07/02/2008...Jason........10...........$500
08/02/2008...Jackie........20...........$400
etc
etc

I wanted to create a button in Sheet1 that will copy the entire row of data in Sheet2 but only within the date range declared in Sheet1. and place the copied row in Sheet1 starting at position A100.

Eg.
Start Date: 05/02/2008
End Date: 07/02/2008
Click button(vba executes)
Copy all rows from lookup sheet2 within these dates and paste it in Sheet1 A100.

Any solution will be very much appreciated.

 

[texasalynn]

try this

Sub CopyDateMatch()
Dim LR As Long, ALR As Long, i As Long
Application.ScreenUpdating = False
LR = ActiveSheet.Cells(65536, 1).End(xlUp).Row

    For i = LR To 1 Step -1
        If Cells(i, 1) >= Sheets("Sheet2").Range("A1") And Cells(i, 1) <= Sheets("Sheet2").Range("B1") Then
            ALR = Worksheets("Sheet1").Cells(65536, 1).End(xlUp).Row + 1
            Rows(i).Copy Destination:=Sheets("Sheet1").Range("A" & ALR)
        End If

    Next i
MsgBox "Done"
Application.ScreenUpdating = True
End Sub

 

[Mike Blackman]

Hi,

How about this as a slightly more efficient alternative to the loop;

Dim lRow As Long

With Sheets("Sheet2")
    lRow = .Range("A" & Rows.count).End(xlUp).Row
    .Range("F2").Formula = "=AND(A2>=Sheet1!$A$1,A2<=Sheet1!$A$2)"
    .Range("A1:D" & lRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("F1:F2"), CopyToRange:=Sheets("Sheet1").Range("A100")
    .Range("F2") = ""
End With

 

[miyage]

Hi,

How about this as a slightly more efficient alternative to the loop;

Dim lRow As Long
 
With Sheets("Sheet2")
    lRow = .Range("A" & Rows.count).End(xlUp).Row
    .Range("F2").Formula = "=AND(A2>=Sheet1!$A$1,A2<=Sheet1!$A$2)"
    .Range("A1:D" & lRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("F1:F2"), CopyToRange:=Sheets("Sheet1").Range("A100")
    .Range("F2") = ""
End With

I tested the code and YES it worked. But theres a problem, It only worked the first time you run the macro. If you change the start date and end dates in sheet1 and run the code. It retains the data from previous execution.

I also get an error if I try to put headings in each of the column in Sheet2. Eg Sheet2 A1-Date B1-Name C1-Number D1-Amount.

What mods in the code can be done to make this work? Much appreciated again for all your help.