Solved

download data to relative range VBA

Posted on 2011-02-14
3
235 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
3 Comments
 
LVL 42

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 42

Expert Comment

by:dlmille
ID: 34894908
gotcha.

Dave
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

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