Copy first 5 characters of Course Name to Column A

[LutonBarry]

Morning folks and a Happy Christmas to you all.

I have written some rudimentary code on the attached that achieves most of what I want it to, don't laugh I'm self taught.

The element I'm stuck on is copying the first 5 letters of the bold lines that contains the Course names into column A. Then copying the new course name when that changes, in this example in cell C15 and C40.

Once that is done I then manually delete from column C the Course name and the blank lines in Col C.

The rest of the code sorts it by race time and inserts a space between each race.

I enclose my worksheet and a copy of what it finally looks like.

The initial data is from the tips section of At The Races website.

[p45cal]

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.

[p45cal]

I've just noticed that the vbaExpress site has replaced instances of three xs (x x x without spaces) in my code with 3 asterisks.
The code in the file won't be affected though.

[LutonBarry]

P45Cal. You got it in one. I am astounded, so fast too. I shall work through this to try and understand what it is you have written.
I am truly in awe of folks such as yourself and it shows what a very long way I have to go to get remotely near the skills of you all.

Many thanks indeed and have a great Christmas.