Link to home
Create AccountLog in
Avatar of thmh
thmh

asked on

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
ASKER CERTIFIED SOLUTION
Avatar of dlmille
dlmille
Flag of United States of America image

Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
Avatar of thmh
thmh

ASKER

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

gotcha.

Dave