Help with Macro to sort BBC football fixtures

[tommyleinen]

Hi all,

The BBC updated their sports pages overnight to a new format which puts my football predictor leagues in a bit of a pickle due to the way the scores etc all run on formulas driven by the BBC fixture format. I think you might call that an achilles heal - or just plain stupidity!

What I need is a macro to sort the new style into the old style, so for example if I paste values of the current format down column A (due to their format this would take up columns A-C). I then need something that can sort them into one column, be it D, or insert a new column A for tidiness' sake. You can find the fixture list here: http://www.bbc.co.uk/sport/football/league-one/fixtures

If you highlight, copy, andtry pasting the values into excel you will see what I mean, the old format is a single cell: Walsall v Notts County, 19:45

Also, at the top of each day's fixtures was the day in the format below:
Tuesday, 31 January 2012
Walsall v Notts County, 19:45

At the end of each day, it needs to skip 2 cells and start the next day's fixtures.

I know a little vba, but not really enough for this to take less than about 10hrs!

If any talented soul could please take a look at this I would be very grateful!

 

[tommyleinen]

That's interesting, I noticed it shaved about 3 seconds off. Thanks for your input Biz, I like the popup - wonder how much variation there will be? I can see another spreadsheet coming on for analysing the distribution... must... resist.

I do have one final query though (last one - promise!); In the previous code you did Bertie, the kick off times all seemed to be in a format I could work with e.g. in Cell I5 on the Template sheet I have =IF(F5="","",F5&","&G5).

This gives at the moment: Chelsea v Bolton,0.625
but with the previous code (cell locations aside) would give: Chelsea v Bolton, 15:00

I have tried playing with the date / time format, but think it is because the previous code pulled the kickoff times with a leading space, any ideas yourselves on how to replicate this?

 

[bertie]

Hi Tommy,

Lazy way, adjust your formula:

=IF(F5="","",F5&","& Text(G5,"hh:mm"))

 

[tommyleinen]

Thankyou once again!

 

[tommyleinen]

Very nice code except I have added code in red to speed up code and msgbox telling time taken.

Sub Main()
   Dim rng As Range
   Dim sUrl As String
   Dim sSheetName As String
   Dim sNumTables As String
   
   Dim aStartTime
    
   [COLOR=red][B]aStartTime = Now()
   
   'Speeding Up VBA Code
    Application.ScreenUpdating = False 'Prevent screen flickering[/B][/COLOR]
  
   
   Set rng = Sheets("Data").Range("A2")
   Do Until rng = ""
      sUrl = rng.Value
      sSheetName = rng.Offset(, 1).Value
      sNumTables = rng.Offset(, 2).Value
      
      ImportFromWeb sUrl, sSheetName, sNumTables
      TidyUp sSheetName
      SeparateDates sSheetName
      
      Set rng = rng.Offset(1, 0)
   Loop
   
   [COLOR=red][B]'Release memory
    Set rng = Nothing
    
    'Speeding Up VBA Code
    Application.ScreenUpdating = True 'Prevent screen flickering
        
    
    MsgBox "Time taken: " & Format(Now() - aStartTime, "h:mm:ss"), vbInformation, "Job Done"
[/B][/COLOR]End Sub

Biz

Wow - down to 9 seconds! Was 27 the first time - must've had a lot running...

 

[Biz]

Wow - down to 9 seconds! Was 27 the first time - must've had a lot running...

Kwel it helped!

Biz

 

[tommyleinen]

Hi Bertie,

Sorry to resurrect this thread so long after it was seemingly completed, the bbc have once again tinkered with the fixtures page (hopefully for the last time for the foreseeable future). The page is much the same but they are splitting by date which shouldn't affect our code as we should be able to simply increase the number of tables we wish to pull data off.

The macro is now halting part way through and on debug I have the following line highlighted:

Sub SeparateDates(ByVal sheetName As String)
Dim lr As Long
Dim i As Long

With Sheets(sheetName)
lr = .Range("A" & .Rows.Count).End(xlUp).Row
For i = lr To 1 Step -1

If i <> 1 Then
If .Range("A" & i).Value <> .Range("A" & i - 1).Value Then
Rows(i).Insert shift:=xlDown
Rows(i).Insert shift:=xlDown
Rows(i).Insert shift:=xlDown
End If
End If
Next i
End With

End Sub


Basically, I have to change the number of tables to a high number to get it to work, if I leave it at "1,2,3,4" Then I get this error.

Fortunately the season is nearly over, so don't worry if you don't have the time or inclination to look at this as I can plod on for a few more weeks and look at getting the fixtures some other way for next season. Thanks for any help in advance though!

 

[tommyleinen]

Hi Bertie,

Sorry to resurrect this thread so long after it was seemingly completed, the bbc have once again tinkered with the fixtures page (hopefully for the last time for the foreseeable future). The page is much the same but they are splitting by date which shouldn't affect our code as we should be able to simply increase the number of tables we wish to pull data off.

The macro is now halting part way through and on debug I have the following line highlighted:

Sub SeparateDates(ByVal sheetName As String)
Dim lr As Long
Dim i As Long

With Sheets(sheetName)
lr = .Range("A" & .Rows.Count).End(xlUp).Row
For i = lr To 1 Step -1

If i <> 1 Then
If .Range("A" & i).Value <> .Range("A" & i - 1).Value Then
Rows(i).Insert shift:=xlDown
Rows(i).Insert shift:=xlDown
Rows(i).Insert shift:=xlDown
End If
End If
Next i
End With

End Sub


Basically, I have to change the number of tables to a high number to get it to work, if I leave it at "1,2,3,4" Then I get this error.

Fortunately the season is nearly over, so don't worry if you don't have the time or inclination to look at this as I can plod on for a few more weeks and look at getting the fixtures some other way for next season. Thanks for any help in advance though!

Actually scratch that, it's not coming out at all how I need it! But it does progress through each league and I can manually grab the info though fiddly it is!