Conditional Copy/Past Based On Date

Microsoft Excel 2007
February 3, 2010 at 23:21:52
Specs: Windows 7
I have a workbook with two sheets. The first
sheet contains customer data. The column of
interest is B. Starting at B4 the column
contains the date the customers order was
entered into our system. On the second sheet
is a cover page that is to contain a recap of a
specific dates orders. Sheet2 cell O14 will
contain a manually input date.

What I am looking for is a formula or macro
that will take the manually input date in cell
O14 on Sheet2, search Sheet1 column B for
that specific date and then copy that rows
data from column C:I onto Sheet2 starting at
B18 going down until all rows containing the
date have been copied.

I would like this to automatically update
Sheet2 each time the date is changed in O14.

Any help with this would be greatly

See More: Conditional Copy/Past Based On Date

February 4, 2010 at 06:51:12

I have written a macro that is triggered by a change in the value of cell O14 - the cell with the date on the summary page.

The macro will need changing if your source and destination sheets are not named Sheet1 and Sheet2.

Select your summary sheet (Sheet2).
Right-click on the name Tab at the bottom of the window and select View code.
Paste the following into the Visual Basic code window that opens (typically right side of the VB window).

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'test if cell that changed contained the date selector
If Target.Address = "$O$14" Then
    'stop all change events from re-triggering this routine
    Application.EnableEvents = False

    Dim rngFirstSrc As Range
    Dim rngLastSrc As Range
    Dim rngFirstDest As Range
    Dim rngLastDest As Range
    Dim rngCell As Range
    Dim intDestRow As Integer
    On Error GoTo ErrHnd
    'set first row with data
    Set rngFirstSrc = Worksheets("Sheet1").Range("A4")
    'find last row with data
    Set rngLastSrc = Worksheets("Sheet1").Range("A65534").End(xlUp)
    'set first row for destination
    Set rngFirstDest = Worksheets("Sheet2").Range("B18")
    'find last row used
    Set rngLastDest = Worksheets("Sheet2").Range("H65534").End(xlUp)
    'Clear destination area if data present
    If rngLastDest.Row > rngFirstDest.Row Then
        Range(rngFirstDest, rngLastDest).ClearContents
    End If
    'set destination row offset counter
    intDestRow = 0
    'find matching data
    'Loop through the source range -  column B
    For Each rngCell In Worksheets("Sheet1"). _
        Range(rngFirstSrc.Address, rngLastSrc.Address)
        'test for matching date
        If rngCell.Offset(0, 1).Value = Target.Value Then
            'extend range from single cell in col A to columns C to I
            'and copy it to destination (B18 + row offset)
            rngCell.Offset(0, 2).Resize(1, 7).Copy _
                Destination:=rngFirstDest.Offset(intDestRow, 0)
            'next row
            intDestRow = intDestRow + 1
        End If
    Next rngCell
    'end message
    If intDestRow = 0 Then
        rngFirstDest.Offset(0, 0).Value = "No records found for " & Target.Text
        rngFirstDest.Offset(0, 7).Value = 0
        rngFirstDest.Offset(intDestRow, 0).Value = "Records found for " & Target.Text
        rngFirstDest.Offset(intDestRow, 6).Value = intDestRow
    End If
End If
're-enable events
Application.EnableEvents = True
Exit Sub
'error handler
Application.EnableEvents = True
End Sub

Change sheet names in code if required.

From the VB file menu select File-Save.
Use Alt+F11 to swap back to the main Excel Window (Alt key & function key #11 together)

Note that this macro finds the last source record by testing cells in column A, so all cells below the last source record in column A must be empty.

Also to clear the previous summary selection, it tests column H, so on the summary worksheet all cells in column H below the last record must be empty.

When any cell on the summary sheet changes, the On Change event is triggered.
This code test if the cell that changed was O14, and if it was, it runs the rest of the macro and copies cells in columns C to I (starting at row 4) to cells B to H on the summary sheet (starting at row 18), but only if the date in column B on the source sheet matches the date in cell O14 on the summary sheet.

It prints a message at the end with the number of records found, or if none puts a 'no record found' message on row 18.
You can remove this message or change it as required - it is not integral to the program.

Test this out on sample data or a copy of your workbook, as changes made by a Macro cannot be undone by the Undo function.

Always make a backup of your data before triggering this macro.

I have only tested this on a limited set of sample data and under conditions that likely do not match yours - so please backup your workbook.


Report •
Related Solutions

Ask Question