Transfer Data Row Based on Date

[Ancient Wolf]

Hello again MrExcel.

Does anyone know of a way to record a macro that, once ran, will search for the oldest date in a column, like Column A, and then transfer the row that contains that date to another sheet in the same workbook? I'm guessing the macro would possibly need to look at more than one cell, if there are multiple rows that have the same date.

Let me know if you need more information than that.

 

[rudfaden]

You can copy all data to a new sheet. Short by column A and then delete all but the first column. I am not sure how to record that, but you can write it in VBA

 

[Ancient Wolf]

Thank you, Rudfaden, for the quick response. I will give your suggestion a try. Shouldn't be too difficult to get Excel to record the macro to do those things.

 

[stnkynts]

Assuming your Source Sheet is sheet 1 and your destination sheet is sheet 2 and your dates are in column A try this:

Option Explicit
Sub CopyOldestDate()
Dim lastrow As Long
Dim newsht As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Sheet1").Copy After:=Sheets(Worksheets.Count)
Set newsht = Sheets(Worksheets.Count)
With newsht
    .Name = "TempSht"
End With
Dim TempSht As Worksheet:   Set TempSht = Sheets("TempSht")
Dim DestSht As Worksheet:   Set DestSht = Sheets("Sheet2")
lastrow = TempSht.Range("A" & Rows.Count).End(xlUp).Row
TempSht.Sort.SortFields.Clear
TempSht.Sort.SortFields.Add Key:=Range("A1:A" & lastrow), _
    SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With TempSht.Sort
    .SetRange Range("A1:IV" & lastrow)
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
TempSht.Range("A" & Rows.Count).End(xlUp).EntireRow.Copy Destination:=DestSht.Range("A" & Rows.Count).End(xlUp)
TempSht.Delete
Sheets("Sheet1").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[Ancient Wolf]

Thank you for your response as well,stnkynts. I will give your suggestion a try.
Right now, I'm trying rudfaden's suggestion, but trying to figure out how to record the macro to filter the dates when the oldest date is ever changing.

 

[Ancient Wolf]

I've gotten your code to work stnkynts, but after which line would I enter coding to make it remove the row from sheet1 after the data has been transferred over to sheet2?

Also, I haven't tested it completely, but does your take into account that there may already be data on sheet2?

 

[stnkynts]

Can the current data on sheet 1 be sorted by date or does it have to stay in the configuration it is in now?

 

[Ancient Wolf]

It could be sorted.

 

[stnkynts]

Try:

Option Explicit
Sub CopyOldestDate()
Dim lastrow As Long
Dim SourceSht As Worksheet:   Set SourceSht = Sheets("Sheet1")
Dim DestSht As Worksheet:   Set DestSht = Sheets("Sheet2")
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
lastrow = SourceSht.Range("A" & Rows.Count).End(xlUp).Row
 
SourceSht.Sort.SortFields.Clear
SourceSht.Sort.SortFields.Add Key:=Range("A1:A" & lastrow), _
    SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With SourceSht.Sort
    .SetRange Range("A1:IV" & lastrow)
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
 
SourceSht.Range("A" & Rows.Count).End(xlUp).EntireRow.Copy Destination:=DestSht.Range("A" & Rows.Count).End(xlUp)
SourceSht.Range("A" & Rows.Count).End(xlUp).EntireRow.Delete Shift:=xlUp
 
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub