Capture values from IE page

[littleiitin]

Hi Maruti,

Please Replace original code with below one I believe this will solve your problem:

Public Sub InkWeb()
    
    Dim MyPost                  As String
    Dim MyUrl                   As String
    Dim PostUser                As String
    Dim PostPassword            As String
    Dim wbkTemp                 As Workbook
    Dim strPrice                As String
    Dim strShipChar             As String
    Dim IEwindow                As SHDocVw.InternetExplorer
    Dim allExplorerWindows      As New SHDocVw.ShellWindows
    Dim rngPaste                As Range
    Dim rngPrice                As Range
    Dim rngShipping             As Range
    Dim rngBML                  As Range
    Application.ScreenUpdating = False
    Set allExplorerWindows = New SHDocVw.ShellWindows
    For Each IEwindow In allExplorerWindows
        
        MyUrl = IEwindow.LocationURL
        If InStr(1, MyUrl, "ebay") > 0 Then
            Set wbkTemp = Workbooks.Add(1)
            With wbkTemp.Worksheets("sheet1").QueryTables.Add(Connection:="URL;" & MyUrl, Destination:=Cells(5, 1))
                .PostText = MyPost
                .BackgroundQuery = True
                .TablesOnlyFromHTML = True
                .Refresh BackgroundQuery:=False
                .SaveData = True
            End With
            With wbkTemp.Worksheets("Sheet1")
                Set rngPrice = .Cells.Find("Price:", , , xlWhole)
                strPrice = rngPrice.Offset(, 1)
                On Error Resume Next
                    Set rngShipping = .Cells.Find("Shipping:", , , xlWhole)
                    
                    'Set rngBML = .Cells.Find("Bill Me Later", , , xlPart)
                    strShipChar = rngShipping.Offset(, 1)

                On Error GoTo 0
            End With
            wbkTemp.Close 0
            Set wbkTemp = Nothing
            With ThisWorkbook.Worksheets("FetchData")
                If .Range("rngPrice").Value <> "" Then
                    If .Range("rngPrice").End(xlDown).Row <> .Rows.Count Then
                        Set rngPaste = .Range("rngPrice").End(xlDown).Offset(1)
                    Else
                        Set rngPaste = .Range("rngPrice").Offset(1)
                    End If
                    rngPaste.Value = strPrice
                    rngPaste.Offset(, 1).Value = strShipChar
                Else
                    MsgBox "Please set the Header ""Price"" in Cell B6", vbInformation
                    Exit Sub
                End If
            End With
        End If
        
    Next

    Application.ScreenUpdating = True
End Sub