Private Sub Button_Click()

Dim LR As Long
Dim Tgtrw As Long

' Insert Sheet Copy and return to Active Sheet code here

LR =Range("A" & Rows.Count).end(xlUp).Row
For Tgtrw = 3 to LR
GTWebAccess Tgtrw 
Next Tgtrw

' Insert Code to delete copy sheet and save workbook here
End Sub

Sub GTWebAccess(ByVal Tgtrw as Long)

Dim IE As New InternetExplorer
Dim Doc As HTMLDocument
Dim NodeList
Dim Elem
Dim X
'IE.Visible = True
IE.navigate "Find Us=" & Range("A" & Tgtrw).Value
 
 Do
 DoEvents
 Loop Until IE.readyState = READYSTATE_COMPLETE
 
 Set Doc = IE.document
 
Application.EnableEvents = False
' Retrieve the Outlet from the h4 tag
Range("B" & Tgtrw).Value = Trim(Doc.getElementsByTagName("h4")(0).innerText)
X = 1
' Retrieve the Paragraph tags
Set NodeList = Doc.getElementsByTagName("p")
For Each Elem In NodeList
'
' The Paragraph info is located in paragraphs 1 through 6
' 1 and 2 contain the Address
' 3 and 4 contain the Telephone
' 5 and 6 contain the E-mail
    Select Case X
        Case Is = 2
           If Elem.innerText = "Just fill in your details" Then
               Range("B" & Tgtrw).Value = "Please enter a valid Post Code"
               Application.EnableEvents = True
               IE.Quit
               Set IE = Nothing
               Exit Sub
            Else
                Range("C" & Tgtrw).Value = Elem.innerText
            End If
        Case Is = 4
            Range("D" & Tgtrw).Value = Elem.innerText
        Case Is = 6
            Range("E" & Tgtrw).Value = Elem.innerText
    End Select
X = X + 1
Next Elem
Application.EnableEvents = True
IE.Quit
Set IE = Nothing
' Set columns B through E column width to 32
Columns("B:E").ColumnWidth =32
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Tgtrw As Long
Tgtrw = Target.Row
If Target.Row = Range("A" & Tgtrw).Row And Target.Column = Range("A" & Tgtrw).Column Then

Dim IE As New InternetExplorer
'IE.Visible = True
IE.navigate "gothere.sg/maps#q:"
'& Range("A" & Tgtrw).Value
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
'Dim Doc As HTMLDocument
Set Doc = IE.document
' Dim sDD As String
Doc.getElementById("q").Value = Range("A" & Tgtrw).Value
Doc.getElementById("ss").Click
sDD = Trim(Application.WorksheetFunction.Substitute(Doc.getElementById("panel").getElementsByClassName("place")(0).getElementsByClassName("locf")(0).innerText, "Singapore " & Range("A" & Tgtrw).Value, ""))
IE.Quit
' Dim aDD As Variant
aDD = Split(sDD, " ") 
Range("B" & Tgtrw).Value = Left(sDD, Application.WorksheetFunction.Find(" ", sDD) - 1)
Range("C" & Tgtrw).Value = Right(sDD, Len(sDD) - Application.WorksheetFunction.Find(" ", sDD))
End If
End Sub