Date Search Macro

Lisa1989

New Member
Joined
Sep 8, 2014
Messages
3
Hi Guys,

It's been a very long time since I've done anything in VBA and I'm struggling to get a Macro to do what I want.

Basically I have a customer database I've setup an entry form (sheet 1) and macro to copy the data to the database (Sheet 2) which automatically calculates a follow-up date a year from installation date.

What I need to do is create a search facility so I can put in a date range e.g. "September 2014" and the macro search the follow up dates and extract all relevant records and paste them into a new workbook so I can run a mailmerge with the follow up letter.

Dates are entered in the following format dd/mm/yyyy

Any help would be fantastic, it's been about 7 years since I've done anything like this and rusty doesn't even cover it!!!

Thanks,

Lisa
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

pbornemeier

Well-known Member
Joined
May 24, 2005
Messages
3,896
Welcome to the Board!

Q1. What column/range on sheet2 holds the dates you want to search through?
Q2a. What cell on sheet 1 holds the date you want to search for?
Q2b. Or do you want to enter start date in 1 cell and end date in another?
Q3. What range before, after or around the date in Q2 range do you want? Q2 to Q2+30 days? 2 to Q2-30 days? Q2+/- 15 days? The month the Q2 is in? Pick one or make something else up.
Q4. What columns in the matching date rows on Sheet2 to you want to copy to a new workbook?
Q5. What should the name of that workbook be?
 

Lisa1989

New Member
Joined
Sep 8, 2014
Messages
3
Hi,

Thanks for responding, in answer to your questions:

Q1. What column/range on sheet2 holds the dates you want to search through? It's column K
Q2a. What cell on sheet 1 holds the date you want to search for?
Q2b. Or do you want to enter start date in 1 cell and end date in another? The start date would be input to sheet 1 (titled Input Screen) F17 and the end date F18
Q3. What range before, after or around the date in Q2 range do you want? Q2 to Q2+30 days? 2 to Q2-30 days? Q2+/- 15 days? The month the Q2 is in? Pick one or make something else up. I want to search for all records between the dates entered in F17 & F18
Q4. What columns in the matching date rows on Sheet2 to you want to copy to a new workbook?It needs to copy all columns from B to G
Q5. What should the name of that workbook be? MM Extraction followed by the extraction date e.g. if this was saved today it would be MM Extraction 13.09.2014

Thanks for your help with this, I've been racking my brains all week how to get around it!

Lisa
 

pbornemeier

Well-known Member
Joined
May 24, 2005
Messages
3,896
This code assumes that you have headers on Sheet2 and that Sheet2!A:K contain data (no empty columns).
Code:
Option Explicit

Sub ExtractDataByDateRangeAndExport()

    Dim sWorksheet As String
    Dim dteStart As Date
    Dim dteEnd As Date
    Dim lLastSheet2DataRow As Long
    Dim lExportedRowCount As Long
    
    'Create export worksheet
    sWorksheet = "MM Extraction " & Format(Now(), "dd.mm.yyyy")
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets(sWorksheet).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Worksheets.Add(After:=Sheets(Sheets.Count)).Name = sWorksheet 'After last
    
    'Get Date range.  No checks done for valid dates or End Date after Start Date
    With Worksheets("Input Screen")
        dteStart = .Range("F17")
        dteEnd = .Range("F18")
    End With
    
    'Filter and Export
    With Worksheets("Sheet2")
        .AutoFilterMode = False
        lLastSheet2DataRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("A1").CurrentRegion.AutoFilter Field:=11, _
            Criteria1:=">=" & Format(dteStart, "m/d/yyyy"), Operator:=xlAnd, _
            Criteria2:="<=" & Format(dteEnd, "m/d/yyyy")
        If Application.WorksheetFunction.Subtotal(3, .Columns("K")) > 1 Then 'Row other than header was filtered
            .Range("B1:G" & lLastSheet2DataRow).SpecialCells(xlCellTypeVisible).Copy _
                Destination:=Worksheets(sWorksheet).Range("A1")
            With Worksheets(sWorksheet)
                lExportedRowCount = .Cells(.Rows.Count, 1).End(xlUp).Row
                .Move 'moves worksheet to new workbook which becomes the activeworkbook
            End With
            With ActiveWorkbook
                .SaveAs sWorksheet & ".xlsx", FileFormat:=51 'xlsx
                .Close
            End With
            MsgBox lExportedRowCount - 1 & " rows exported to " & sWorksheet & ".xlsx", , "Data Exported"
        Else
            MsgBox "No rows fall within the date range: " & Format(dteStart, "dd.mm.yyyy") & " to " & _
                Format(dteEnd, "dd.mm.yyyy"), , "No Rows Filtered"
        End If

        .AutoFilterMode = False
    End With

End Sub
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,629
Messages
5,838,453
Members
430,549
Latest member
jayjay2022

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top