Delete all data prior except by selected dates and name.

[Sunline]

Hello all ,

I have a workbook that contains approx 350,000 rows of data .
The data is basically history of horses dating back to 2003.
This data is updated approx daily with new meetings that just occurred .

I have some complex macros which source previous statistical history . The main macro only runs on approx 60,000 rows .
By being able to delete all the ones I don’t want I am able to get right back to there very first start .

What I need is to delete every other horse prior to first date (4/09/2014) in col AA except those listed by the following dates ,
4/09/2014
5/09/2014
6/09/2014 , the dates are in col F . Doing it this way I can just change the dates , etc .

Basically ending up with every horses history including the above 3 dates and prior . Each will vary differently .

Any ideas will be a great help . Not sure if this is a major macro or not .

Thanks .

 

[Michael M]

So, just to be clear, you want to delete all rows if the date in Col F is before 04/09/14....which was in fact, last Thursday ??

 

[Sunline]

Hello Michael , thanks for reply .

Yes , sort of to answer your question .
In this example sheet below Fred and Joe would be deleted because they dont have the 3 x dates mentioned above .
But Maximum Height ,
Revolt ,
Starcheeka previous results would stay and not be deleted . Any three of these horses could have up to and including 100 previous starts at the track .
Thanks .
Starcheeka

Excel Workbook
	F	AA
1	Date	Horse
2	29/08/2014	Maximum Height
3	29/08/2014	Revolt
4	29/08/2014	Starcheeka
5	30/08/2014	Fred
6	31/08/2014	Joe
7	4/09/2014	Maximum Height
8	4/09/2014	Revolt
9	4/09/2014	Starcheeka
10	4/09/2014	Bellino
11	5/09/2014	Have No Mercy
12	5/09/2014	Goldminer
13	6/09/2014	Allanah
14	6/09/2014	Nine Pin
15	6/09/2014	Pycok Flyer
16	6/09/2014	Mapmaker
Sheet1

 

[Michael M]

Can the data be sorted by Column "AA" ??

 

[Sunline]

Yes it can be sorted by col AA.
Thanks .

 

[Sunline]

Just to mention i did try this macro which deletes data also.
Row 11 of this macro i tried changing the "1" and "1=" with some horses names but i got errors and it didnt work .

If i could get this to work i would also have to get a function that can add appostrophies and blanks and comas as it would take a long time if i had 350 horses to do in one day .

Had to try this anyway .

Excel Workbook
	A
1	Sub Del_Rows()
2	Dim lr As Long, lc As Long, i As Long, rws As Long
3	Dim aCol, tmp
4
5	lr = Range("AA" & Rows.Count).End(xlUp).Row
6	lc = Cells(1, Columns.Count).End(xlToLeft).Column
7	aCol = Range("AA2:AA" & lr).Value
8	ReDim tmp(1 To lr - 1, 1 To 1)
9	For i = 1 To lr - 1
10	Select Case UCase(aCol(i, 1))
11	Case "1", "1="
12
13	Case Else
14	rws = rws + 1
15	tmp(i, 1) = 1
16	End Select
17	Next i
18	If rws > 0 Then
19	Application.ScreenUpdating = False
20	Application.Calculation = xlCalculationManual
21	Application.EnableEvents = False
22	With Range("A2").Resize(lr - 1)
23	.Offset(, lc).Value = tmp
24	.Resize(, lc + 1).Sort Key1:=.Cells(1, lc + 1), _
25	Order1:=xlAscending, Header:=xlNo
26	.Resize(rws).EntireRow.Delete
27	.Offset(, lc).ClearContents
28	End With
29	Application.EnableEvents = True
30	Application.Calculation = xlCalculationAutomatic
31	Application.ScreenUpdating = True
32	End If
33	MsgBox "Done"
34	End Sub
Sheet1

 

[Michael M]

Give this a try

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub MM1()
Dim lr As Long, r As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "F").End(xlUp).Row
Range("AA2").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("AA2:AA" & lr) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("F2:F" & lr) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange ActiveSheet.UsedRange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
For r = lr To 2 Step -1
    If DateValue(Range("F" & r).Value) < DateValue("4/09/2014") And Range("AA" & r).Value <> Range("AA" & r + 1).Value Then
    Rows(r).Delete
    End If
Next r
Application.ScreenUpdating = True
End Sub

 

[Sunline]

I ran the macro for an hour last night and stopped it to have a look .

It only did one horses history and went back approx 7 starts .

It definately was working but i think it may take a very long time to calculate my data .

Thanks for the go at it tho .