Solved

download data to relative range VBA

Posted on 2011-02-14
3
231 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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Go is an acronym of golang, is a programming language developed Google in 2007. Go is a new language that is mostly in the C family, with significant input from Pascal/Modula/Oberon family. Hence Go arisen as low-level language with fast compilation…
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 demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

932 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

8 Experts available now in Live!

Get 1:1 Help Now