Sub test()
Application.ScreenUpdating = False

ThisWorkbook.Activate
Worksheets("ApplicationData").Select

Dim IE As Object
Dim HTMLDoc As Object
Dim oRange As Range
Dim pos As Long

Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False

For Each cell In Selection.Cells

    IE.Navigate "http://www.chsc.hk/ssp/main.php?lang_id=1"
    While IE.readyState < 4
    Application.Wait DateAdd("s", 1 / 1000, Now)
    Wend
    Set HTMLDoc = IE.Document
    
    
    HTMLDoc.getElementById("sch_name").Value = Cells(cell.Row, 2).Value
    HTMLDoc.getElementById("btn_search").Click
    
                            
    Application.Wait DateAdd("s", 1, Now)
                            
                            
    For Each tr In HTMLDoc.getElementsByTagName("tr")
        If tr.className = "psp_table_line2_bgcolor" Then
            IE.Navigate tr.getElementsByTagName("a")(0).href
            Exit For
        End If
    Next
    
    Application.Wait DateAdd("s", 1, Now)
    
    Cells(cell.Row, 3).Value = HTMLDoc.getElementsByTagName("span")(3).innerText
    Cells(cell.Row, 4).Value = HTMLDoc.getElementsByTagName("td")(73).innerText

    Set oRange = Cells(cell.Row, 4).Find(What:="(", LookAt:=xlPart)
        
    If Not oRange Is Nothing Then
        pos = Application.WorksheetFunction.Find("(", Cells(cell.Row, 4).Value) - 1
        Cells(cell.Row, 4) = Trim(Left(Cells(cell.Row, 4).Value, pos))
    End If


Next cell


IE.Quit
Set IE = Nothing
Application.ScreenUpdating = True

End Sub

 Application.Wait DateAdd("s", 1, Now)