Macro to select data within a date range.

**dannymcg** · 06-12-2012, 04:09 AM

Hi All,

I'm rather struggling with something and would really appreciate some help.

I have a spreadsheet with up to 1000 rows. The data we are interested in is "leave date" and "confirmed".

I need a macro or code to copy the whole row when the "leave date" was within 13 weeks and confirmed = no. If possible, the new data would appear on a new worksheet in the same book.

Please see attached data sample.

(Ideally, I would be using a database application however I don't currently have the resource)

**arlu1201** · 06-12-2012, 05:05 AM

when the "leave date" was within 13 weeks

13 wks of what?

**puru.sve** · 06-12-2012, 05:13 AM

Try this code .. your output sheet will be sheet2

Sub copyleave()

Dim lastDate As Date
Dim lastRow, counter, incRow As Integer

incRow = 2
lastDate = Date - 13 * 7 ' to fetch last 13 week date

With ActiveSheet
Sheets("sheet2").Range("A1:F1").Value = .Range("A1:F1").Value 'Copy the heading
    lastRow = .Range("A65536").End(xlUp).Row  ' count the how many row

    For counter = 2 To lastRow
        'Checking the condition for 13 week and confirmed No
        If CDate(.Range("D" & counter).Value) >= lastDate And UCase(.Range("F" & counter).Value) = "NO" Then
            
            Sheets("sheet2").Range("A" & incRow & ":" & "F" & incRow).Value = .Range("A" & counter & ":" & "F" & counter).Value
            incRow = incRow + 1
        
        End If
    
    Next

End With

End Sub

**dannymcg** · 06-12-2012, 05:30 AM

Hi arlu,

Apologies , 13 weeks of todays date.

**WHER** · 06-12-2012, 05:44 AM

For a formula-based approach, see attachment.
The "within 13 weeks" requirement was simplified to:difference between today and leave date is smaller than 13*7. Adapt if necessary.