Copying and pasting a web query

[Jeffrey Green]

I have a good web query set up, but now I need to replicate it 600 times . . .each baseball team, for the last 20 years.

The only difference between URLs is the team abbreviation, and the year. So instead of ARI/1997, I need ARI/1996, etc. then DET/1997 then DET/1996.

Is there an "easy" way of just copying what I have and changing the URL?

Thanks

 

[Jeffrey Green]

Today, this macro isn't doing the web query . . .it prompts me, and moves the cursor down 163 rows. but no data is extracted from the table . . .

Suggestions?

 

[John_w]

You haven't answered my question so I don't know if my code is importing the correct data.

I don't know why it isn't working today. You could try debugging the code in the VB editor and/or do a manual web query for the same data.

 

[Jeffrey Green]

Oh, your query is awesome. but sometimes it doesn't pull in data . . it just moves the cursor down 163 rows and re-prompts me for team code and year.

IT SEEMS that if it doesn't work, if i select all of the cells in the worksheet and delete all, then it works . . . . odd.

What about the possibility of having the macro read from a named range of all the teams and years?

Thanks again

 

[Jeffrey Green]

I got the macro to work, so I put 20 years of NYY on sheet1.
But when I tried putting DET on Sheet 2 I get a System Error...The Parameter is incorrect . . . .

I know I am entering DET 1990 correctly . . .

Thoughts?

 

[John_w]

What about the possibility of having the macro read from a named range of all the teams and years?

Try the code below in a module in a new workbook. The team codes and years are in a named range called 'Teams', with team codes in the first column and years in the adjacent column. In my test workbook Teams refers to =Sheet3!$A$2:$B$7. The web page data is retrieved to Sheet2.

Sub Get_Data_Loop_Named_Range()

    'Team codes and years in named range 'Teams' (2 columns, n rows excluding column headers, on Sheet3).  Web data is retrieved
    'for each team code and year to next available row on Sheet2
   
    Dim teamsRange As Range
    Dim webDataSheet As Worksheet
    Dim teamCell As Range
    Dim webQuery As QueryTable
    Dim destinationRow As Long, row As Long
    
    Set teamsRange = Range("Teams")
    Set webDataSheet = Sheets("Sheet2")
    
    webDataSheet.Cells.ClearContents
    
    For row = teamsRange.row To teamsRange.row + teamsRange.Rows.Count - 1
    
        With webDataSheet
            destinationRow = .Cells(Rows.Count, "A").End(xlUp).row
            If destinationRow <> 1 Then destinationRow = destinationRow + 2
            .Activate
            .Range("A" & destinationRow).Select
            
            'Copy team code and year to data sheet
            
            teamsRange.Item(row, 1).Resize(1, 2).Copy .Range("A" & destinationRow)
            destinationRow = destinationRow + 1
            
            'Retrieve web page data for this team code and year
            
            Set webQuery = .QueryTables.Add(Connection:="URL;http://www.baseball-reference.com/teams/" & _
                    teamsRange.Item(row, 1).Value & "/" & teamsRange.Item(row, 2).Value & "-schedule-scores.shtml", _
                    Destination:=Range("A" & destinationRow))
            With webQuery
                .Name = "schedule-scores.shtml"
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .BackgroundQuery = True
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .WebSelectionType = xlSpecifiedTables
                .WebFormatting = xlWebFormattingNone
                .WebTables = """team_schedule"""
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=False
            End With
        
            webQuery.Delete
            DoEvents
            
        End With
    
    Next
    
    'Remove all column header rows except row 1 from web data sheet
    
    destinationRow = Cells(Rows.Count, "A").End(xlUp).row
    For row = destinationRow To 2 Step -1
        If Cells(row, "A").Value = "Rk" And Cells(row, "B").Value = "Gm#" Then
            Rows(row).Delete Shift:=xlUp
        End If
    Next
    
    Cells(Rows.Count, "A").End(xlUp).Select
    
End Sub