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