How can I restrain the screen from flickering while parsing data from web?

[shahin]

Hi there! Hope you all are doing well. I've written some code for the purpose of scraping names and urls from several links found in the left sided bar in a webpage and populate the data in several sheets [also giving each sheet a new name taking a customized portion from url] in a workbook so that things do not get messy and the data can be located separately. I tried to do the whole thing accurately and found it working great. However, the only problem I'm facing is that while scraping the results, the screen is flickering [don't know the actual term to use here]. I tried to turn the display alerts off but I don't think I know the proper usage of it that is because I commented it out in my script. Hope someone will take a look into this. Here is what I did:

Sub Web_Data()

Const link = "http://www.wiseowl.co.uk"
Dim http As New XMLHTTP60, html As New HTMLDocument, htm As New HTMLDocument
Dim topics As Object, topic As Object, newlinks As String, ws As Worksheet

With http
    .Open "GET", "http://www.wiseowl.co.uk/videos/", False
    .send
    html.body.innerHTML = .responseText
End With

'Application.DisplayAlerts = False

Set topics = html.getElementsByClassName("woMenuList")(0).getElementsByTagName("a")
    For x = 1 To topics.Length - 1
        newlinks = link & Split(topics(x).href, ":")(1)
      
         With http
            .Open "GET", newlinks, False
            .send
            htm.body.innerHTML = .responseText
        End With

        With ThisWorkbook
            Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
            ws.Name = Split(Split(Split(newlinks, "videos/")(1), "/")(1), ".")(0)
        End With

        Set topic = htm.getElementsByClassName("woVideoListDefaultSeriesTitle")

        For Each item In topic
            i = i + 1
            Cells(i, 1) = item.getElementsByTagName("a")(0).innerText
            Cells(i, 2) = link & Split(item.getElementsByTagName("a")(0).href, ":")(1)
        Next item
        i = 0
    Next x
'    Application.DisplayAlerts = True
End Sub

 

[shahin]

Apology in advance for the weird naming of the variables I've declared in my script.

 

[shahin]

Btw, while stretching a helping hand, you might need this piece of macro as well to delete the newly populated worksheets.

Sub removing_sheets()
    Dim ws As Worksheet
  
    Application.DisplayAlerts = False
  
    For Each ws In ThisWorkbook.Worksheets
        If Not ws Is Sheet1 Then ws.Delete
    Next ws
  
End Sub

 

[Hui]

Have you tried adding towards the start

Application.Screenupdating = False

at the end

Application.Screenupdating = True

 

[shahin]

Thanks sir Hui. It solved the problem. How stupid I'm!! I didn't even think about it. It works as I expected. Btw, is it the right way of placing the lines, I meant the position.

Sub Web_Data()

Const link = "http://www.wiseowl.co.uk"
Dim http As New XMLHTTP60, html As New HTMLDocument, htm As New HTMLDocument
Dim topics As Object, topic As Object, newlinks As String, ws As Worksheet

With http
    .Open "GET", "http://www.wiseowl.co.uk/videos/", False
    .send
    html.body.innerHTML = .responseText
End With

Application.ScreenUpdating = False

Set topics = html.getElementsByClassName("woMenuList")(0).getElementsByTagName("a")
    For x = 1 To topics.Length - 1
        newlinks = link & Split(topics(x).href, ":")(1)
       
         With http
            .Open "GET", newlinks, False
            .send
            htm.body.innerHTML = .responseText
        End With

        With ThisWorkbook
            Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
            ws.Name = Split(Split(Split(newlinks, "videos/")(1), "/")(1), ".")(0)
        End With

        Set topic = htm.getElementsByClassName("woVideoListDefaultSeriesTitle")

        For Each item In topic
            i = i + 1
            Cells(i, 1) = item.getElementsByTagName("a")(0).innerText
            Cells(i, 2) = link & Split(item.getElementsByTagName("a")(0).href, ":")(1)
        Next item
        i = 0
    Next x
    Application.ScreenUpdating = True
End Sub

 

[Hui]

Looks Good

Just remember that if it crashes you won't be able to update the screen

so typically add an error handler like:

Sub Web_Data()

Const link = "http://www.wiseowl.co.uk"
Dim http As New XMLHTTP60, html As New HTMLDocument, htm As New HTMLDocument
Dim topics As Object, topic As Object, newlinks As String, ws As Worksheet

With http
    .Open "GET", "http://www.wiseowl.co.uk/videos/", False
    .send
    html.body.innerHTML = .responseText
End With

Application.ScreenUpdating = False
on error goto EH

Set topics = html.getElementsByClassName("woMenuList")(0).getElementsByTagName("a")
    For x = 1 To topics.Length - 1
        newlinks = link & Split(topics(x).href, ":")(1)
       
         With http
            .Open "GET", newlinks, False
            .send
            htm.body.innerHTML = .responseText
        End With

        With ThisWorkbook
            Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
            ws.Name = Split(Split(Split(newlinks, "videos/")(1), "/")(1), ".")(0)
        End With

        Set topic = htm.getElementsByClassName("woVideoListDefaultSeriesTitle")

        For Each item In topic
            i = i + 1
            Cells(i, 1) = item.getElementsByTagName("a")(0).innerText
            Cells(i, 2) = link & Split(item.getElementsByTagName("a")(0).href, ":")(1)
        Next item
        i = 0
    Next x

EH:
    Application.ScreenUpdating = True
End Sub

 

[shahin]

Thanks a lot for everything.