Solved

download data to relative range VBA

Posted on 2011-02-14
3
228 Views
Last Modified: 2012-05-11
hy,
have macro that downloads football results ,if matches are played in 2 or more days
 then macro needs  to run every day matches are played  ,
if i run it second time macro  overwrites already downloaded results ,
so i need macro when ruining in second time  to skip downloading data already downloaded first day and continue from not downloaded data

workbook in attachment
Book94.xls
0
Comment
Question by:thmh
  • 2
3 Comments
 
LVL 41

Accepted Solution

by:
dlmille earned 300 total points
ID: 34893788
Ok.  I coded as follows:

If there's a score on the results, the application skips (it uses Instr() function searching for " - " which "means" it has a score - so no long waits just to get it to update the 8th game, for example). So the update routine is embedded in the if statement, if not Instr() > 0 then... e.g., if the " - " is not found, THEN do the update.

Without complicating things (did the user run this a "first time"? or not), I eliminated any clearing of scores on the bottom, but added a macro button below the refresh button, to handle overall cleanup, by league.

So, you can clean up the scoreboard.  You can update scores.  Next time you update it skips to the next game that is not scored, etc.

I believe this is what you're asking for and hope it helps!

PS - clever application you have there!

Dave
Football-r1.xls
0
 

Author Comment

by:thmh
ID: 34894783
Dave your code worked , i just  added part  copy/past not scored matches ,
here is final code ,
tnx
Option Explicit

Sub get_webdata_1_Sheet_temp_k1()
Dim str As String
Dim Rng As Range
Dim celle As Range
Dim n As Long
Dim games As Long
Dim hDoc As Object
Dim coll As Object
'Dim team1 As String
'Dim team2 As String
Dim score1 As String
'Dim score2 As String
Dim objIE As Object
Dim intTeams As Integer
 
On Error GoTo skip1
Sheets("Temp").Select
If Range("B4") = 1 Or Range("B4") = "" Or Range("B30") <> "" Then GoTo skip1

    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Visible = True

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    With Sheets("Temp")
        Set Rng = Range(.Cells(4, "B"), .Cells(4, "B").End(xlDown))
        games = .Cells(4, "B").End(xlDown).Row - 3
    End With
 
    n = 1
    
    Sheets("Temp").Select
    
   ' Sheets("Temp").Select
   ' Range("B19:B30").Cells.ClearContents
   ' Range("B4:B15").Select
   ' Application.CutCopyMode = False
   ' Selection.Copy
   ' Range("B19").Select
   ' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    For Each celle In Rng
        Application.DisplayStatusBar = True
        Application.StatusBar = "Processing game No. " & n & " out of " & games
 If Not InStr(1, celle.Offset(15, 0).Value, " - ") > 0 Then 'skip if score already there
        str = celle.Hyperlinks(1).Address
        objIE.Navigate2 str

         Do While objIE.readystate <> 4
             DoEvents
         Loop
        Set hDoc = objIE.document
        score1 = ""

        If InStr(hDoc.body.innerhtml, "highlights") < InStr(hDoc.body.innerhtml, "comments-announce") Then
           
           For Each coll In hDoc.getelementsbytagname("Span")
                If coll.classname = "vs" Then
                    score1 = coll.innertext
                End If
'                If coll.classname = "home" Then
'                    team1 = coll.innertext
'                End If
'                If coll.classname = "away" Then
'                    team2 = coll.innertext
'                End If
            Next
        End If

        Sheets("Temp").Range("B18").Offset(n - 15, 0).Copy
        Sheets("Temp").Range("B18").Offset(n, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    If score1 > "-" Then
        
        Sheets("Temp").Range("B18").Offset(n, 0).Replace What:=" v ", Replacement:=" " & score1 & " ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False 'team1 & " " & score1 & " " & team2
        
        Else
        
        Sheets("Temp").Range("B18").Offset(n, 0) = ""
        
    End If
  End If
        n = n + 1
    Next celle
    With Sheets("Temp")
        .Activate
        .[B19].Select
    End With
    Application.DisplayStatusBar = True
'skip1:
    objIE.Quit


    Range("B19:B30").Select
    Selection.Replace What:="- 5", Replacement:="- 4(5)", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="5 -", Replacement:="(5)4 -", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="- 6", Replacement:="- 4(6)", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="6 -", Replacement:="(6)4 -", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="- 7", Replacement:="- 4(7)", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="7 -", Replacement:="(7)4 -", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="- 8", Replacement:="- 4(8)", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="8 -", Replacement:="(8)4 -", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
        
        
skip1:

'    Set objIE = CreateObject("InternetExplorer.Application")
If objIE.Visible = True Then
    objIE.Quit
End If



End Sub

Open in new window

0
 
LVL 41

Expert Comment

by:dlmille
ID: 34894908
gotcha.

Dave
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

It was really hard time for me to get the understanding of Delegates in C#. I went through many websites and articles but I found them very clumsy. After going through those sites, I noted down the points in a easy way so here I am sharing that unde…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now