[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 240
  • Last Modified:

download data to relative range VBA

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
thmh
Asked:
thmh
  • 2
1 Solution
 
dlmilleCommented:
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
 
thmhAuthor Commented:
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
 
dlmilleCommented:
gotcha.

Dave
0

Featured Post

Important Lessons on Recovering from Petya

In their most recent webinar, Skyport Systems explores ways to isolate and protect critical databases to keep the core of your company safe from harm.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now