Macro to Copy Data Based on Date

Microsoft Microsoft office excel 2007 ac...
March 21, 2010 at 07:50:33
Specs: Windows XP
I have 3 sheets namely Master, Eoil, Coolent, Filter. In the later 3 sheets I have several rows and columns (specificially with dates)
now I need a Macro button code which should copy the rows and columns when i enter a particular date and if the date matches in any of the sheets. Thanks in advance

See More: Macro to Copy Data Based on Date

Report •


#1
March 21, 2010 at 08:14:44
Hi,

You need to provide more information.

If you think about it, you couldn't write a macro or even a formula if you weren't given the addresses of the cells containing the data.

What columns hold the dates on each sheet, including the worksheet named "Master".

You say copy the rows and columns .
What is to be copied - one row, two rows, twenty rows, or do you want columns copied.

You need to specify exactly what is to be copied and exactly where it is to be copied to. When talking about copying rows, consider if copying the whole row is OK, or do you want just a certain range of cells in the row copied.

Regards


Report •

#2
March 25, 2010 at 22:11:22
Sheet 1 named = Master
sheet 2 - EOil
Sheet 3 - Coolent

Sheet 2, 3...contains data as follows
Sl Vehicle Servicedate Kms Servicedate Kms
1 1582 1-Jan-10 15000 2-Mar-10 47000
2 1617 2-Jan-10 15000 3-Mar-10 47000

In sheet 1, if I enter a particular date, it should display the
Vechile, service date and kms of that date of Eoil sheet and next from Coolent sheet.


Report •

#3
March 26, 2010 at 06:21:37
Hi,

1
It is not clear what you mean by of that date of Eoil sheet and next from Coolent
When you enter a date on the Master sheet, do you want all vehicle information from the Eoil worksheet if the first date (presumably column C) is an exact match, and the details of the next vehicle from the Coolant worksheet, i.e., the vehicle after the one that has a matching date in column C.

2
You also say that you want to copy Vehicle, service date and kms of that date, but there are two sets of dates and Kms for each vehicle. Do you want both copied.

3.
You haven't said anything about the layout of information on the Master sheet, and it is not clear if you just want one set of vehicle information visible on the Master sheet - when a new date is entered is the previous data overwritten, or are you creating a series of rows of data by adding the new data below the existing data.

The following macro makes the following assumptions:
1. On the Master sheet dates are entered into one cell - cell A2.
2. When a date is entered, if there is a matching date in column C (i.e., the first date column) on the Eoil worksheet, cell A4 will show "Engine oil", followed by the vehicle number and then two sets of dates, and Kms. in columns B to F.
3. When a date is entered, if there is a matching date in column C (i.e., the first date column) on the Coolant worksheet, cell A5 will show "Coolant", followed by the vehicle number and then two sets of dates, and Kms. in columns B to F.

4. Although 2 & 3 above show the data in rows 4 and 5, the data will be placed on consecutive rows, for example if there is no match for the date on the Eoil sheet, then the first match from the Coolant sheet will go on row 4. Also if there were two matches from the Eoil sheet, then the first match from the Coolant sheet would go on row 6.

5. Row 3 on the Master worksheet contains headers.

6. When a new date is entered in cell A2, the data for the previous date will be erased.

7. The first row containing data on both the Eoil and Coolant sheets is row 2

This macro is triggered when the date in cell A2 is changed.
Right-click on the Name tab at the bottom of the Master worksheet. Select View Code.

In the code window that opens enter this:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'stop changes from re-triggering this macro
Application.EnableEvents = False

On Error GoTo ErrHnd

'test if cell changed is A2
If Target.Address = "$A$2" Then
    'test if A2 contains a valid date
    If Not IsDate(Target) Then
        'not a valid date so give a warning
        MsgBox "Cell A2 must contain a valid date"
        Else
        'a valid date so proceed
        Dim rngDestStart As Range
        Dim rngDestEnd As Range
        Dim rngCoolStart As Range
        Dim rngCoolEnd As Range
        Dim rngOilStart As Range
        Dim rngOilEnd As Range
        Dim rngCell As Range
        Dim intRow As Integer
        
        'set start and end ranges on destination worksheet
        Set rngDestStart = Worksheets("Master").Range("A4")
        Set rngDestEnd = Worksheets("Master"). _
                    Range("A" & CStr(Application.Rows.Count)).End(xlUp)
        'test that there is data to delete - don't want to delete headers in row 3
        If rngDestEnd.Row < 4 Then
            Set rngDestEnd = Worksheets("Master").Range("A4")
        End If
        
        'set start rows on both source worksheets
        Set rngCoolStart = Worksheets("Coolant").Range("B2")
        Set rngOilStart = Worksheets("Eoil").Range("B2")
        
        'find last used row in both source worksheets
        Set rngCoolEnd = Worksheets("Coolant"). _
                    Range("B" & CStr(Application.Rows.Count)).End(xlUp)
        Set rngOilEnd = Worksheets("Eoil"). _
                    Range("B" & CStr(Application.Rows.Count)).End(xlUp)
        
        'set destination row counter to 4 - the first row for results
        intRow = 4
        
        'clear all destination data (Master worksheet)
        For Each rngCell In Worksheets("Master").Range(rngDestStart, rngDestEnd)
            'select each row and delete data
            rngCell.EntireRow.Clear
        Next rngCell
        
        'loop through column C on Eoil worksheet looking for matching dates
        For Each rngCell In Worksheets("Eoil").Range(rngOilStart, rngOilEnd)
            If rngCell.Offset(0, 1).Value = Target.Value Then
                'matching date, so move data to Master worksheet
                'put service type in column A
                Worksheets("Master").Range("A" & CStr(intRow)).Value = "Engine Oil"
                rngCell.Resize(1, 5).Copy _
                        Destination:=Worksheets("Master").Range("B" & CStr(intRow))
                'increment destination row counter
                intRow = intRow + 1
            End If
        Next rngCell
        'loop through column C on Coolant worksheet looking for matching dates
        For Each rngCell In Worksheets("Coolant").Range(rngCoolStart, rngCoolEnd)
            If rngCell.Offset(0, 1).Value = Target.Value Then
                'matching date, so move data to Master worksheet
                'put service type in column A
                Worksheets("Master").Range("A" & CStr(intRow)).Value = "Coolant"
                rngCell.Resize(1, 5).Copy _
                        Destination:=Worksheets("Master").Range("B" & CStr(intRow))
                'increment destination row counter
                intRow = intRow + 1
            End If
        Next rngCell
    End If
End If
'reenable events
Application.EnableEvents = True
Exit Sub

'error handler
ErrHnd:
Err.Clear
Application.EnableEvents = True
End Sub

Click Save from the Visual Basic Menu.

Alt+f11 takes you back to the main Excel window.

As Macros cannot be undone with the Undo button, test this macro on a copy of your data. Always make a backup of your Workbook before running this macro. This code has only been tested on sample data, and it has not been tested in your environment, so test it on copies of your data to ensure that it works 'as expected'

Here is my sample output after entering a date in cell A2 on the Master worksheet.

The source worksheets "Eoil" and "Coolant" had three entries with this date in column C.

	A		B	C		D	E		F
1	Date					
2	12-Jan-10					
3	Type		Vehicle	Servicedate	Kms	Servicedate	Kms
4	Engine Oil	1414	12-Jan-10	18000	07-Feb-10	25000
5	Engine Oil	1218	12-Jan-10	27000	14-Feb-10	34000
6	Coolant		1558	12-Jan-10	24000	12-Feb-10	30000

Regards


Report •

Related Solutions


Ask Question