Fetching data from website and feed it in the desired cells

Rahulkr

Board Regular
Joined
Dec 10, 2019
Messages
66
Office Version
  1. 2010
Platform
  1. Windows
Dear,
Please help me out to retrieve data from this website and feed those data into the excel Any help will be appreciated . I am trying on this below codes, but not getting the success

VBA Code:
Sub Scrape_Stats()
 'Create Internet Explorer Browser
 Dim appIE As Object
 Set appIE = CreateObject("internetexplorer.application")
 
 'Ask Browser to navigate to website (.Visible=False will hide IE when running)
 With appIE
 .Navigate "https://transferwise.com/sg/swift-codes/bic-swift-code-checker?code="
 .Visible = True
 End With
 
 'Have the macro pause while IE is busy opening and navigating
 Do While appIE.Busy
 DoEvents
 Loop
 
 'Designate the table to be extracted
 Dim contentDiv As Object
 Set contentDiv = appIE.Document.getElementById("placeholder")
 Dim dataTable As Object
 Set dataTable = contentDiv.getElementsByTagName("d-block")(1)
 
 'Close IE and clear memory
 appIE.Quit
 Set appIE = Nothing
 
 'Clear area and paste extracted text into the appropriate sheet/cells
 Worksheets("Sheet1").Range("B2").ClearContents
 Sheets("Sheet1").Select
 Range("B2").Select
End Sub

I am having the following type of excel sheet as below.
I want if BIC Code is filled then automatic Bank details get filled in all the columns as desired.

BIC CodeBank NameLine2 AutoLine 3 AutoLine 4 Auto
AACIFRP1XXXABN AMRO COMMUNICATIONS INTERNATIONALESPARISFRANCE
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Code:
Sub Scrape_Stats()
    Dim lrow As Long, i As Long, x As Long
    Dim BICCode As String, ScrapedText As String
    Dim appIE As Object
    Dim strArr() As String
       
    'Get the last row A
    lrow = Cells(Rows.Count, 1).End(xlUp).Row
      
    For i = 2 To lrow
        Set appIE = CreateObject("internetexplorer.application")
        BICCode = Range("A" & i).Value
        ScrapedText = ""
        
        With appIE
            .Navigate "https://transferwise.com/sg/swift-codes/bic-swift-code-checker?code=" & BICCode
            .Visible = False
        End With
    
    'Have the macro pause while IE is busy opening and navigating
        Do While appIE.Busy
            DoEvents
        Loop
        
        ScrapedText = appIE.Document.getElementsByClassName("list-group-item")(0).innertext
        strArr = Split(ScrapedText, vbNewLine)
        
        For x = 0 To UBound(strArr)
                Cells(i, x + 2).Formula = strArr(x)
        Next

        appIE.Quit
        Set appIE = Nothing
    Next
    
End Sub
 
Upvote 0
Hi, my idea

Book1
ABC
1BOFAUS3NBank Of America N.A (BOFAUS3NINQ)
2Bank Of America N.A (BOFAUS3NXXX)
3
Rahulkr


VBA Code:
Option Explicit
'by Hernan Torres (Mikel ERP)
'December 13, 2019
'Refer to Rahulkr sheet
'topic: Fetching data from website and feed it in the desired cells

Sub take_list_from_web()
Dim doc, hcol As Variant
Dim text As Object
Dim myStr As String
Dim ie As InternetExplorer
Dim strURL, SWIFTCode As String
Dim i, j As Integer

SWIFTCode = Sheets("Rahulkr").Range("A" & i + 1).Value
Set ie = New InternetExplorer
strURL = "https://transferwise.com/sg/swift-codes/bic-swift-code-checker?code=" & SWIFTCode
'ie.Visible = True
ie.navigate (strURL)
Do While ie.readyState <> READYSTATE_COMPLETE
    DoEvents
Loop
While ie.Busy
    DoEvents
Wend
Set doc = ie.document
i = 0
    For Each text In doc.getElementsByTagName("a")
        'If you have more than one like BOFAUS3N, the list start in 28
        If InStr(text.href, SWIFTCode) > 0 Then
        'MsgBox "Lo encontre"
        myStr = doc.getElementsByTagName("a")(i).innerText
        j = j + 1
        Sheets("Rahulkr").Range("B" & j).Value = myStr
        End If
    i = i + 1
    Next

Set ie = Nothing
MsgBox "All codes for " & SWIFTCode & " were taken", vbInformation, "Mikel ERP by htorres"
End Sub
 
Upvote 0
Hi, my idea

Book1
ABC
1BOFAUS3NBank Of America N.A (BOFAUS3NINQ)
2Bank Of America N.A (BOFAUS3NXXX)
3
Rahulkr


VBA Code:
Option Explicit
'by Hernan Torres (Mikel ERP)
'December 13, 2019
'Refer to Rahulkr sheet
'topic: Fetching data from website and feed it in the desired cells

Sub take_list_from_web()
Dim doc, hcol As Variant
Dim text As Object
Dim myStr As String
Dim ie As InternetExplorer
Dim strURL, SWIFTCode As String
Dim i, j As Integer

SWIFTCode = Sheets("Rahulkr").Range("A" & i + 1).Value
Set ie = New InternetExplorer
strURL = "https://transferwise.com/sg/swift-codes/bic-swift-code-checker?code=" & SWIFTCode
'ie.Visible = True
ie.navigate (strURL)
Do While ie.readyState <> READYSTATE_COMPLETE
    DoEvents
Loop
While ie.Busy
    DoEvents
Wend
Set doc = ie.document
i = 0
    For Each text In doc.getElementsByTagName("a")
        'If you have more than one like BOFAUS3N, the list start in 28
        If InStr(text.href, SWIFTCode) > 0 Then
        'MsgBox "Lo encontre"
        myStr = doc.getElementsByTagName("a")(i).innerText
        j = j + 1
        Sheets("Rahulkr").Range("B" & j).Value = myStr
        End If
    i = i + 1
    Next

Set ie = Nothing
MsgBox "All codes for " & SWIFTCode & " were taken", vbInformation, "Mikel ERP by htorres"
End Sub

If you have problems, please add Application.Wait after next; see below ?
VBA Code:
...
    i = i + 1
    Next
Application.Wait (Now + #12:00:05 AM#)
Set ie = Nothing
MsgBox "All codes for " & SWIFTCode & " were taken", vbInformation, "Mikel ERP by htorres"
End Sub
 
Upvote 0
tHIS
Code:
Sub Scrape_Stats()
    Dim lrow As Long, i As Long, x As Long
    Dim BICCode As String, ScrapedText As String
    Dim appIE As Object
    Dim strArr() As String
      
    'Get the last row A
    lrow = Cells(Rows.Count, 1).End(xlUp).Row
     
    For i = 2 To lrow
        Set appIE = CreateObject("internetexplorer.application")
        BICCode = Range("A" & i).Value
        ScrapedText = ""
       
        With appIE
            .Navigate "https://transferwise.com/sg/swift-codes/bic-swift-code-checker?code=" & BICCode
            .Visible = False
        End With
   
    'Have the macro pause while IE is busy opening and navigating
        Do While appIE.Busy
            DoEvents
        Loop
       
        ScrapedText = appIE.Document.getElementsByClassName("list-group-item")(0).innertext
        strArr = Split(ScrapedText, vbNewLine)
       
        For x = 0 To UBound(strArr)
                Cells(i, x + 2).Formula = strArr(x)
        Next

        appIE.Quit
        Set appIE = Nothing
    Next
   
End Sub
Thank you very much for the modification, it actually worked, but each and every time I have to run the macro manually, I want if the code is filled and pressed ENTER then all data automatically filled. If possible please provide me for the same.
 
Upvote 0
If you have problems, please add Application.Wait after next; see below ?
VBA Code:
...
    i = i + 1
    Next
Application.Wait (Now + #12:00:05 AM#)
Set ie = Nothing
MsgBox "All codes for " & SWIFTCode & " were taken", vbInformation, "Mikel ERP by htorres"
End Sub
Dear, Thank you for code, but your code is throwing some error as "User-defined type not defined" .
 
Upvote 0
Please try this:

VBA Code:
Option Explicit
'by Hernan Torres (Mikel ERP)
'December 13, 2019: Update on December 17, 2019
'Refer to Rahulkr sheet
'topic: Fetching data from website and feed it in the desired cells

Sub take_list_from_web()
Dim doc, hcol As Variant
Dim text As Object
Dim myStr As String
Dim ie As Object 'New InternetExplorer
Dim strURL, SWIFTCode As String
Dim i, j As Integer

Application.ScreenUpdating = False
Sheets("Rahulkr").Range("B1:B5").ClearContents
SWIFTCode = Sheets("Rahulkr").Range("A" & i + 1).Value
'Run ("killIEexplorer")
Set ie = New InternetExplorer
strURL = "https://transferwise.com/sg/swift-codes/bic-swift-code-checker?code=" & SWIFTCode
ie.Visible = True
ie.navigate (strURL)
Do While ie.readyState <> READYSTATE_COMPLETE
    DoEvents
Loop
While ie.Busy
    DoEvents
Wend
Set doc = ie.document
i = 0
Application.Wait (Now + #12:00:10 AM#)
    For Each text In doc.getElementsByTagName("a")
        'If you have more than one like BOFAUS3N, the list start in 28
        If InStr(text.href, SWIFTCode) > 0 Then
        'MsgBox "Lo encontre", vbInformation, "Mikel ERP by htorres"
        myStr = doc.getElementsByTagName("a")(i).innerText
        j = j + 1
        Sheets("Rahulkr").Range("B" & j).Value = myStr
        End If
    i = i + 1
    Next
ie.Quit
Set ie = Nothing
Set doc = Nothing
Application.ScreenUpdating = True
If j > 0 Then
MsgBox "All codes for " & SWIFTCode & " were taken", vbInformation, "Mikel ERP by htorres"
Else
MsgBox "Code: " & SWIFTCode & " was not found", vbCritical, "Mikel ERP by htorres"
End If
End Sub

You can see entire example here
 
Upvote 0
Please try this:

VBA Code:
Option Explicit
'by Hernan Torres (Mikel ERP)
'December 13, 2019: Update on December 17, 2019
'Refer to Rahulkr sheet
'topic: Fetching data from website and feed it in the desired cells

Sub take_list_from_web()
Dim doc, hcol As Variant
Dim text As Object
Dim myStr As String
Dim ie As Object 'New InternetExplorer
Dim strURL, SWIFTCode As String
Dim i, j As Integer

Application.ScreenUpdating = False
Sheets("Rahulkr").Range("B1:B5").ClearContents
SWIFTCode = Sheets("Rahulkr").Range("A" & i + 1).Value
'Run ("killIEexplorer")
Set ie = New InternetExplorer
strURL = "https://transferwise.com/sg/swift-codes/bic-swift-code-checker?code=" & SWIFTCode
ie.Visible = True
ie.navigate (strURL)
Do While ie.readyState <> READYSTATE_COMPLETE
    DoEvents
Loop
While ie.Busy
    DoEvents
Wend
Set doc = ie.document
i = 0
Application.Wait (Now + #12:00:10 AM#)
    For Each text In doc.getElementsByTagName("a")
        'If you have more than one like BOFAUS3N, the list start in 28
        If InStr(text.href, SWIFTCode) > 0 Then
        'MsgBox "Lo encontre", vbInformation, "Mikel ERP by htorres"
        myStr = doc.getElementsByTagName("a")(i).innerText
        j = j + 1
        Sheets("Rahulkr").Range("B" & j).Value = myStr
        End If
    i = i + 1
    Next
ie.Quit
Set ie = Nothing
Set doc = Nothing
Application.ScreenUpdating = True
If j > 0 Then
MsgBox "All codes for " & SWIFTCode & " were taken", vbInformation, "Mikel ERP by htorres"
Else
MsgBox "Code: " & SWIFTCode & " was not found", vbCritical, "Mikel ERP by htorres"
End If
End Sub

You can see entire example here
Sorry My friend, it is not working and often the site use to open and showing some errors.
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,185
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top