Home / Macros / Transfer most Recent Records

Transfer most Recent Records

The ExcelHelpDesk Support team received the following request for help

Problem – Identify the most Recent Records in a Worksheet

I have a workbook that has one sheet, The sheet lists each ID with multiple records of DATE. Could you kindly inform me how to get the “earliest date” for each ID, so the table in Sheet1 will become the table in Sheet2?

I was following the steps from http://www.excelhelpdesk.com/functions/vlookup-search-earliest-date/ but I was not able to get the full result to Sheet2. I only get the earliest date to Sheet2 > B2. On Sheet2 when I copied B2 to B3, I got the same date result which was not what I wanted.

It would be so great that you can help with showing the result on Sheet2 and the formula on Sheet2.

For this problem we received a sample workbook. See the screen shot below of the worksheet that was the starting point for the data that needed to be transferred. As you can see the data includes multiple rows of data for the same ID and DATE. This request needed to firstly identify the records that were a unique set and then to only transfer the first record for that set to a Result worksheet.

In the screen shot below we have highlighted the records that were not to be transferred to the Result worksheet.

Step 1 – Clean up Data

To acheive the transfer a Macro has been developed that will first “clean” the data and then sort it ready for comparison. Finally it will transfer the data to the “Result” worksheet. The sample file supplied included for each DATE value in the Column B an ‘ character in front of the date. Effectively this told Excel to ignore this a date and treat it as TEXT.

The first step in our macro was to remove that ‘ character and format the cell to a DATE format.

Step 2 – Sort the Data for Transfer

The next step was to sort the data into ID and DATE order for a comparison to occur. This is acheived by setting an appropriate range within the Worksheet and then using .Cells.Sort to re-order the list.

Step 3 – Lastly the Compare and Transfer

Lastly the rows are stepped through one by one to compare for duplicate ID / DATE combinations. As a new combination is found it is transferred to the Result Worksheet.

Now for the VBA script that performs this transfer. You will see that the From Worksheet and To Worksheet are constants and need to be varied if you are not using worksheets with these names. The starting cell is also set to A1 and this can be changed by modifying the constant below.

Option Explicit
 
Sub TransferRecentRecord()
'This routine will transfer the most recent record from one Worksheet list of many records
'To another Worksheet
 
Const wsFromWorksheet = "Sheet1"
Const wsToWorksheet = "Result"
Const strStartRange = "A1"
 
Dim wsSourceWorksheet               As Worksheet
Dim wsResultWorksheet               As Worksheet
Dim myRange                         As Range
Dim myResultRange                   As Range
Dim i                               As Long
Dim j                               As Long
Dim dtePreviousDate                 As Date
Dim strPreviousID                   As String
 
    Set wsSourceWorksheet = ThisWorkbook.Worksheets(wsFromWorksheet)
    Set wsResultWorksheet = ThisWorkbook.Worksheets(wsToWorksheet)
 
    'First lets remove the ' character from each date cell in the Source if it exists
    Set myRange = wsSourceWorksheet.Range(strStartRange)
    i = 1
    Do While myRange.Offset(i, 0).Value <> ""
        If Not myRange.Offset(i, 1).NumberFormat = "yyyy-mm-dd" Then
            myRange.Offset(i, 1).NumberFormat = "yyyy-mm-dd"
            myRange.Offset(i, 1).Value = Replace(myRange.Offset(i, 1).Value, "'", "")
        End If
        i = i + 1
    Loop
 
    'Now sort the Source records by Date Descending
    Set myRange = wsSourceWorksheet.Range(strStartRange)
    Set myRange = Range(myRange, myRange.End(xlToRight))
    Set myRange = Range(myRange, myRange.End(xlDown))
    With myRange
        .Cells.Sort Key1:=.Columns(1), Order1:=xlAscending, Header:=xlYes, _
                    Key1:=.Columns(2), Order1:=xlAscending
    End With
 
    'Now transfer the most recent records to the Result worksheet
    wsResultWorksheet.Cells.Clear
    Set myResultRange = wsResultWorksheet.Range(strStartRange)
    Set myRange = wsSourceWorksheet.Range(strStartRange)
    dtePreviousDate = #1/1/1901#
    strPreviousID = ""
    i = 0
    j = 0
    Do While myRange.Offset(i, 0).Value <> ""
 
        'Transfer the Heading Row
        If i = 0 Then
            myRange.Offset(i, 0).EntireRow.Copy
            myResultRange.Offset(j, 0).PasteSpecial
            j = j + 1
 
        'Check if we need to Transfer this Detail Row
        Else
 
            If dtePreviousDate <> myRange.Offset(i, 1).Value Or _
            strPreviousID <> myRange.Offset(i, 0).Value Then
                myRange.Offset(i, 0).EntireRow.Copy
                myResultRange.Offset(j, 0).PasteSpecial
                dtePreviousDate = myRange.Offset(i, 1).Value
                strPreviousID = myRange.Offset(i, 0).Value
                j = j + 1
            End If
        End If
        i = i + 1
    Loop
 
End Sub

Use this in your Own Workbook

If you have a similar need as described in this workbook you can apply to your situation by modifying the Constant values at the start of the script and also ensuring that the columns you need to sort and match on are updated in the sections of the macro performing those steps.

To help you get started here is a link to a Sample Workbook that includes the Macro discussed above.

Download Sample Workbook

If you have a question on this post for the Excel Help Desk team or have something you would like to share on this topic then please leave a comment

About Excel Help Desk

Check Also

CTRL+F1 to Hide the Excel Toolbar using VBA

There are a number of options to solve this problem, the simplest approach we found for this request was the combination of the "SendKeys" function and the Workbook_Activate procedure. Basically we created a routine that would Hide the Toolbar each time the workbook was activated. Then when the workbook was closed or de-activated it would reset the Toolbar to the original state.