Importing web query from web script error

[Bucko3030]

Hi I have been using a web query to imports data for my hockey pool. I been importing it for about 2 years now from yahoo sports everything was fine. Untill yesterday yahoo must have change something now I can't import the data any more I go check my connection I get script error line 18512 char 1 error 'Y' is undefined code 0 here is the webpage i use NHL - Statistics by Position - Yahoo Canada Sports it was easy to import before i would just put the yellow arrow next the players name and save now i can't put the arrow by the players now i can only import the whole web page but then my code don't work.

 

[VBA Geek]

Ok

 

[Bucko3030]

Ok VBA Geek is been helping me a lot and thanks you but iam still having problems with my file his code works to pull the data in but now my formula doesn't work to pull from one tab to the others here I will post my file if anyone eles wants to have a look and help me out Thanks.
here is my file http://www12.zippyshare.com/v/58636274/file.html iam trying to upload stats to the players tab then uses this formula to imported the stats to each player on each team. =IF(ISNUMBER(MATCH($D5, Players!$A$1:$A$835,0)),INDEX(Players!NHL_2010_skaters, MATCH($D5, Players!$A$1:$A$835,0), MATCH(E$4, Players!$A$1:$CB$1, 0)),0)
It was working when I used the web query but now that I get script errors not sure what is wrong

 

[ukmikeb]

Hi

Change the definition of the Named Range - NHL_2010_Skaters using :-

=OFFSET($A$2,0,0,COUNTA($A$2:$A$1000),1)

in the Refers to field.

That way the range becomes dynamic as it is currently showing only the first two cells constitute that range.

And in your formula you could replace the instances of "Players!$A$2:$A835" with the new reference.

hth

 

[Bucko3030]

ok this would be In the formula right not the code. sorry been about 6 years since I did any excel formulas

 

[ukmikeb]

Hi

An amendment is required to the definition of the Named Range - NHL_2010_Skaters that I gave you in Post #13 as follows :-

=OFFSET($A$2,0,0,COUNTA($A$2:$A$1000),90)

which caters for the variation in some of the formulae in the "owners" sheet eg Mud Ducks.

After the above change your formula in Post #12 should work satisfactorily.

Note some of the formulae in the above sheet have references to "Players!$A$2:$A$2" rather than "Players!$A$2:$A$835".

hth

 

[ukmikeb]

Hi

Here is a revised version of the code :-

Sub Bucko3030()
'
' Bucko3030 Macro
'
    Dim aBrowser As Object
    Dim htm As Object
    Dim elemCollection As Object

 Dim URLPArray
 Dim ShtArray
 Dim MyArray

 Dim d As Long, r As Long, c As Long
 Dim i As Integer
      
 URLPArray = Array("C,RW,LW,D", "G&conference=NHL&year=season_2013&qualified=1")
 ShtArray = Array("Players", "Goalies")
 Application.Calculation = xlCalculationManual
For i = 0 To 1
    Sheets(ShtArray(i)).Select
    Range("A1").Select
    If i = 0 Then
        Range("NHL2010_Players").Offset(2).ClearContents
    Else
        Range("NHL2010_Goalies").Offset(2).ClearContents
    End If
 
    Set htm = CreateObject("htmlFile")

    With CreateObject("msxml2.xmlhttp")
        .Open "GET", "http://ca.sports.yahoo.com/nhl/stats/byposition?pos=" & URLPArray(i) & "", False
        .Send
        htm.body.innerhtml = .responsetext
    End With

    Set elemCollection = htm.getElementsBytagName("table")(4)
    
    For r = 0 To elemCollection.Rows.Length - 1
        ReDim MyArray(elemCollection.Rows(0).Cells.Length - 1)
        d = 0
        For c = 0 To elemCollection.Rows(r).Cells.Length - 1
            If c > 2 And elemCollection.Rows(r).Cells(c).innertext = Chr$(32) Then GoTo Nxtc
                MyArray(d) = elemCollection.Rows(r).Cells(c).innertext
                d = d + 1
Nxtc:
        Next c
        
        Cells(r + 1, 1).Resize(, elemCollection.Rows(0).Cells.Length) = MyArray
Nxtr:
    Next r

Set htm = Nothing
Next i

Application.Calculation = xlCalculationAutomatic
'
End Sub

It recreates both the Players and the Goalies sheets.


hth

 

[Bucko3030]

I get a run time error and it highlights Range("NHL2010_Skaters").Offset(2).ClearContents

 

[ukmikeb]

Hi

Sorry I put NHL2010_Players and it should have been NHL2010_Skaters.

If it still occurs then comment out this section :-

    If i = 0 Then
        Range("NHL2010_Players").Offset(2).ClearContents
    Else
        Range("NHL2010_Goalies").Offset(2).ClearContents
    End If

 

[Bucko3030]

Hi

Here is a revised version of the code :-

Sub Bucko3030()
'
' Bucko3030 Macro
'
    Dim aBrowser As Object
    Dim htm As Object
    Dim elemCollection As Object

 Dim URLPArray
 Dim ShtArray
 Dim MyArray

 Dim d As Long, r As Long, c As Long
 Dim i As Integer
      
 URLPArray = Array("C,RW,LW,D", "G&conference=NHL&year=season_2013&qualified=1")
 ShtArray = Array("Players", "Goalies")
 Application.Calculation = xlCalculationManual
For i = 0 To 1
    Sheets(ShtArray(i)).Select
    Range("A1").Select
    If i = 0 Then
        Range("NHL2010_Players").Offset(2).ClearContents
    Else
        Range("NHL2010_Goalies").Offset(2).ClearContents
    End If
 
    Set htm = CreateObject("htmlFile")

    With CreateObject("msxml2.xmlhttp")
        .Open "GET", "http://ca.sports.yahoo.com/nhl/stats/byposition?pos=" & URLPArray(i) & "", False
        .Send
        htm.body.innerhtml = .responsetext
    End With

    Set elemCollection = htm.getElementsBytagName("table")(4)
    
    For r = 0 To elemCollection.Rows.Length - 1
        ReDim MyArray(elemCollection.Rows(0).Cells.Length - 1)
        d = 0
        For c = 0 To elemCollection.Rows(r).Cells.Length - 1
            If c > 2 And elemCollection.Rows(r).Cells(c).innertext = Chr$(32) Then GoTo Nxtc
                MyArray(d) = elemCollection.Rows(r).Cells(c).innertext
                d = d + 1
Nxtc:
        Next c
        
        Cells(r + 1, 1).Resize(, elemCollection.Rows(0).Cells.Length) = MyArray
Nxtr:
    Next r

Set htm = Nothing
Next i

Application.Calculation = xlCalculationAutomatic
'
End Sub

It recreates both the Players and the Goalies sheets.


hth

Everything on your code was working good but this morning iam getting a run-time error saying access denided when I hit debug the .Send is what is highlighted

 

[ukmikeb]

Hi

Replace this section of code :-

    Set htm = CreateObject("htmlFile")

    With CreateObject("msxml2.xmlhttp")
        .Open "GET", "http://ca.sports.yahoo.com/nhl/stats/byposition?pos=" & URLPArray(i) & "", False
        .Send
        htm.body.innerhtml = .responsetext
    End With

with this :-

Set aBrowser = CreateObject("InternetExplorer.Application")
    With aBrowser
        .Silent = True
        .Visible = False
        .Navigate "http://ca.sports.yahoo.com/nhl/stats/byposition?pos=" & URLPArray(i) & """
        While .Busy Or .ReadyState <> 4: DoEvents: Wend
    End With
    
    Set htm = aBrowser.Document

and replace these two lines :-

Set htm = Nothing
Next i

with

Set aBrowser = Nothing
Set htm = Nothing
Set elemCollection = Nothing
Next I

If that fails with the same error then try the remedy mentioned in this thread :-
vbscript - msxml3.dll Access Denied - Stack Overflow

Good luck.