PDA

View Full Version : [SOLVED] Copy first 5 characters of Course Name to Column A



LutonBarry
12-19-2016, 12:41 AM
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:laugh2:.

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
12-19-2016, 10:23 AM
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
12-19-2016, 11:15 AM
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
12-19-2016, 11:28 AM
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.