Ideally i would like a macro to do this automatically.
"Read" the current matches i have connected to excel and give the result in a cell
I am sure it can be done but don't know how.
If someone can provide such a code it would be very helpful
I have found something similar but i can't make it work
it gives me an error, and it is updating all scores
If anyone have an idea please tell me so
thanks
m
--------------------------------------------------------------------------------
Option Explicit
Private IE As Object
Dim t As Date
Sub StartTimer()
If t <> CDate(0) Then Exit Sub
Call xscores
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=t, Procedure:="xscores", Schedule:=False
t = CDate(0)
Call DisconnectFrom
On Error GoTo 0
End Sub
Private Function NavigateTo(strURL As String)
If IE Is Nothing Then Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = False
.Navigate strURL
Do Until (.ReadyState = 4 And Not .Busy): DoEvents: Loop
End With
End Function
Private Function DisconnectFrom()
IE.Quit
Set IE = Nothing
End Function
Sub xscores()
Application.ScreenUpdating = False
Dim strURL As String
Dim ieDoc As Object
Dim AllTables As Object
Dim xTable As Object
Dim myWkSht As Worksheet
Dim TblRow As Object
Dim tblCell As Object
Dim r As Integer
Dim c As Integer
Columns("N:O").NumberFormat = "@"
strURL = "http://xscores.com/LiveScore.do?state=soccer&sport=1"
If t = CDate(0) Then
Call NavigateTo(strURL)
End If
Set ieDoc = IE.Document
Set AllTables = ieDoc.frames(3).Document.frames(1).Document.getElementsByTagName("TABLE")
Set xTable = AllTables.Item(0)
Set myWkSht = ThisWorkbook.Sheets("Sheet1")
r = 0
c = 0
For Each TblRow In xTable.Rows
r = r + 1
For Each tblCell In TblRow.Cells
c = c + 1
myWkSht.Cells(r, c) = tblCell.innerText
Next tblCell
c = 0
Next TblRow
r = 0
Dim rng As Range
For Each rng In Range(Sheets(1).Range("A1"), Sheets(1).Range("A65536").End(xlUp))
If rng.Text = "K/O" Then
rng.Offset(0, 3).Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
rng.Offset(0,
.Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
rng.Offset(0, 16).Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next rng
Columns("U:U").ClearContents
Range("A1").Select
'Call DisconnectFrom
't is set at 1 minute intervals
t = Now() + TimeValue("00:01:00")
Application.OnTime EarliestTime:=t, Procedure:="xscores", Schedule:=True
Application.ScreenUpdating = True
End Sub