The following is a one-step process after you've copied the stuff in the website pages into a fresh sheet.
Note the following:
Paste into Column A of a fresh sheet
Make sure this sheet is the active sheet when you run the macro blah
The data is mostly gleaned from the hyperlinks, so two things:
- You don't need the racecourse name at the top (although it doesn't matter if you do copy it), you can copy just the races (this is because the racecourse data is within the hyperlinks).
- When you paste into the sheet, don't overwrite any previously copied hyperlinks. (The code expects the hyperlinks to be in Column A.)
The code creates a new sheet from scratch every time, for your final data.
Sub blah()
Set OrigSht = ActiveSheet
LR = OrigSht.Cells(Rows.Count, "A").End(xlUp).Row
Set NewSht = Sheets.Add(after:=Sheets(Sheets.Count))
DestRow = 0
With NewSht
For Each cll In OrigSht.Range("A1:A" & LR).Cells
If cll.Hyperlinks.Count > 0 Then
*** = Split(cll.Hyperlinks(1).Address, "/")
yyy = Split(cll.Value, ":")
If LCase(***(3)) = "racecard" Then
DestRow = DestRow + 1
Set Destn = .Cells(DestRow, "A")
Destn.Value = Left(***(4), 5) 'first 5 letters of racecourse
Destn.Offset(, 1).Value = Left(cll.Value, 5) 'time
Destn.Offset(, 1).Value = Destn.Offset(, 1).Value + DateValue(***(5)) 'optional line if you want date info in column B too.
End If
If LCase(yyy(0)) = "top tip" Then
Destn.Offset(, 2) = cll.Value 'top tip
End If
If LCase(yyy(0)) = "watch out for" Then
Destn.Offset(, 3) = cll.Value 'watch out for
End If
End If
Next cll
.Range("A1").CurrentRegion.Sort key1:=.Range("B1"), order1:=xlAscending, Header:=xlNo
Sorted = .Range("A1").CurrentRegion.Value
ReDim Final(1 To UBound(Sorted) * 3, 1 To 3)
FRow = 1
For i = 1 To UBound(Sorted)
Final(FRow, 1) = Sorted(i, 1)
Final(FRow + 1, 1) = Sorted(i, 1)
Final(FRow, 2) = Sorted(i, 2)
Final(FRow + 1, 2) = Sorted(i, 2)
Final(FRow, 3) = Sorted(i, 3)
Final(FRow + 1, 3) = Sorted(i, 4)
FRow = FRow + 3
Next i
.Range("A1").CurrentRegion.Clear
.Range("A2").Resize(UBound(Final), 3) = Final
.Range("B2").Resize(UBound(Final)).NumberFormat = "hh:mm"
For Each are In .Columns("A").SpecialCells(xlCellTypeConstants, 23).Areas
are.Rows(1).Resize(, 5).Interior.Color = 12566463
Next are
With .Range("A1:E1")
.Value = Array("Course", "Time", "Race", "Result", "Odds")
.Font.Bold = True
.EntireColumn.AutoFit
End With
End With
End Sub
Paste the above code into a module (add it to your current Module1 (it replaces all the existing code), or if you like, post it into a new Module).
I'm guessing you're wanting to evaluate how good these tips are, and that you may want to collate a sheet with many days' of tips and actual results; your current code only grabs the time and puts it into column B, but the macro blah puts the date and time into coliumn B but formats it so that you only see time. Because of this you can copy paste loads of data from several days into a single sheet, sort on column B (even change column B to show the date too). If you really don't want that date data, you can delete/comment-out the line in the code which has the comment on it: 'optional line if you want date info in column B too.
The attached also has the above code in it. I've copied some website data into the single sheet in the attached, you just need to Alt+F8, and run blah.