VBA - HTML add data below previous

[jamescooper]

Hello, my code here works it loops through what is in column A of sheet 2, but it does not add that data below the previous data pull. How can I adapt the code below to make that work please?

Many thanks.

Sub Cards()
  
  Dim IE As InternetExplorer
  Set IE = New InternetExplorer
  Dim Dline As Range
  
  For Each Dline In Sheet2.Range("A1:A" & Range("A" & Rows.Count).End(xlUp).row)


  Set IE = CreateObject("InternetExplorer.Application")
  With IE
  .Navigate Dline.Value
  .Visible = True
  Do While IE.ReadyState <> READYSTATE_COMPLETE
  DoEvents
  Loop
  Application.Wait Now + TimeValue("00:00:01")
  End With
 
  Dim html As HTMLDocument
  Set html = IE.Document
 
  Dim ele As IHTMLElementCollection
  Dim lists As IHTMLElementCollection
  Dim row As Long
  
  Set ele = html.getElementsByTagName("div")
  For Each e In ele
      If e.className = "level level-2 card-pager" Then
          Set lists = e.getElementsByTagName("div")
          row = 1
          For Each div In lists
            Cells(row, 1) = div.innerText
            row = row + 1
          Next
      End If
  Next e
  
  Set ele = html.getElementsByTagName("div")
  For Each e In ele
      If e.className = "level level-5 form" Then
          Set lists = e.getElementsByTagName("strong")
          row = 1
          For Each strong In lists
            Cells(row, 2) = strong.innerText
            row = row + 1
          Next
      End If
  Next e
    
  IE.Quit
  Set IE = Nothing
  Next Dline
  
  End Sub

 

[Leith Ross]

Hello jamescooper,

This should work..

Sub Cards()
  
  Dim IE As InternetExplorer
  Set IE = New InternetExplorer
  Dim Dline As Range
  
  For Each Dline In Sheet2.Range("A1:A" & Range("A" & Rows.Count).End(xlUp).row)
  Set IE = CreateObject("InternetExplorer.Application")
  With IE
  .Navigate Dline.Value
  .Visible = True
  Do While IE.ReadyState <> READYSTATE_COMPLETE
  DoEvents
  Loop
  Application.Wait Now + TimeValue("00:00:01")
  End With
 
  Dim html As HTMLDocument
  Set html = IE.Document
 
  Dim ele As IHTMLElementCollection
  Dim lists As IHTMLElementCollection
  Dim row As Long
  
  row = Cells(Rows.Count, "A").End(xlUp).row
  row = IIf(row = 1 And IsEmpty(Cells(1, 1)), 1, row + 1)


  Set ele = html.getElementsByTagName("div")
  For Each e In ele
      If e.ClassName = "level level-2 card-pager" Then
          Set lists = e.getElementsByTagName("div")
          For Each div In lists
            Cells(row, 1) = div.innerText
            row = row + 1
          Next
      End If
  Next e
  
  row = Cells(Rows.Count, "B").End(xlUp).row
  row = IIf(row = 1 And IsEmpty(Cells(1, 2)), 1, row + 1)
  
  Set ele = html.getElementsByTagName("div")
  For Each e In ele
      If e.ClassName = "level level-5 form" Then
          Set lists = e.getElementsByTagName("strong")
          For Each strong In lists
            Cells(row, 2) = strong.innerText
            row = row + 1
          Next
      End If
  Next e
    
  IE.Quit
  Set IE = Nothing
  Next Dline
  
  End Sub

 

[jamescooper]

Hello jamescooper,

This should work..

Sub Cards()
  
  Dim IE As InternetExplorer
  Set IE = New InternetExplorer
  Dim Dline As Range
  
  For Each Dline In Sheet2.Range("A1:A" & Range("A" & Rows.Count).End(xlUp).row)
  Set IE = CreateObject("InternetExplorer.Application")
  With IE
  .Navigate Dline.Value
  .Visible = True
  Do While IE.ReadyState <> READYSTATE_COMPLETE
  DoEvents
  Loop
  Application.Wait Now + TimeValue("00:00:01")
  End With
 
  Dim html As HTMLDocument
  Set html = IE.Document
 
  Dim ele As IHTMLElementCollection
  Dim lists As IHTMLElementCollection
  Dim row As Long
  
  row = Cells(Rows.Count, "A").End(xlUp).row
  row = IIf(row = 1 And IsEmpty(Cells(1, 1)), 1, row + 1)


  Set ele = html.getElementsByTagName("div")
  For Each e In ele
      If e.ClassName = "level level-2 card-pager" Then
          Set lists = e.getElementsByTagName("div")
          For Each div In lists
            Cells(row, 1) = div.innerText
            row = row + 1
          Next
      End If
  Next e
  
  row = Cells(Rows.Count, "B").End(xlUp).row
  row = IIf(row = 1 And IsEmpty(Cells(1, 2)), 1, row + 1)
  
  Set ele = html.getElementsByTagName("div")
  For Each e In ele
      If e.ClassName = "level level-5 form" Then
          Set lists = e.getElementsByTagName("strong")
          For Each strong In lists
            Cells(row, 2) = strong.innerText
            row = row + 1
          Next
      End If
  Next e
    
  IE.Quit
  Set IE = Nothing
  Next Dline
  
  End Sub

Thanks, that still seems to be overwriting the previous data rather than adding below?

Any further ideas?

Many thanks.