Import date wise data from web page

[Yugadi Luitel]

Hi, I am trying to import date-wise exchange rate from this link: "Exchange Rates | Da Afghanistan Bank" I want the first coloumn to be the date and then from the second column onward the exchange rates for USD. I want excel to automatically perform this function and get the rates from 1 January to 31 December of a particular year. Is it possible it automated?

 

[HongRu]

Try VBA.
Copy the code below into a new workbook's VBA Module.
(Open a new Workbook and press Alt+F11 , and then insert a new Module to copy the code)
(Press F5 to run the macro.)
Run the main code "sbGetWebByPQ".
You can set the first day by "myDate1", and the last day by "myDate2 ".
Hope you enjoy this.

'sbGetWebByPQ is the Main code.
Sub sbGetWebByPQ()
    Dim myTimer
    myTimer = Now()
    Application.ScreenUpdating = False
    Dim myDate1
    myDate1 = DateValue("1/1/2021")  'M/D/YYYY, the first day
    Dim myDate2
    myDate2 = DateValue("3/1/2021") 'the last day
   
    Dim myName 'Query name is also date.
    Dim myYear
    Dim myMonth
    Dim myDay
    ThisWorkbook.Worksheets.Add
    For myName = myDate1 To myDate2
        myYear = Year(myName)
        myMonth = Month(myName)
        myDay = Day(myName)
        'Add a Power Query
        ThisWorkbook.Queries.Add Name:=myName, _
                                   Formula:="let" & _
                                   Chr(13) & "" & Chr(10) & _
                                   "Data = Web.Page(Web.Contents(""https://www.dab.gov.af/exchange-rates?field_date_value=" & _
                                                    myMonth & "%2F" & _
                                                    myDay & "%2F" & _
                                                    myYear & """))," & _
                                   Chr(13) & "" & Chr(10) & _
                                   "Data0 = Data{0}[Data]," & _
                                   Chr(13) & "" & Chr(10) & _
                                   "Data1 = Table.TransformColumnTypes(Data0,{{""Currency"", type text}, {""Cash (Sell)"", type number}, {""Cash (Buy)"", type number}, {""Transfer (Sell)"", type number}, {""Transfer (Buy)"", type number}})," & _
                                   Chr(13) & "" & Chr(10) & _
                                   "Data2 = Table.SelectRows(Data1, each ([Currency] = ""USD$""))," & _
                                   Chr(13) & "" & Chr(10) & _
                                   "Data3 = Table.AddColumn(Data2, ""Date"", each """ & myName & """)," & _
                                   Chr(13) & "" & Chr(10) & _
                                   "Data4 = Table.ReorderColumns(Data3,{""Date"", ""Currency"", ""Cash (Sell)"", ""Cash (Buy)"", ""Transfer (Sell)"", ""Transfer (Buy)""})," & _
                                   Chr(13) & "" & Chr(10) & _
                                   "Data5 = Table.TransformColumnTypes(Data4,{{""Date"", type date}})" & _
                                   Chr(13) & "" & Chr(10) & _
                                   "in" & _
                                   Chr(13) & "" & Chr(10) & _
                                   "Data5"
        'Add a Table from Power Query
        With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
            "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""" & myName & """;Extended Properties=""""" _
            , Destination:=Range("H1").Offset(i * 2, 0)).QueryTable
            .CommandType = xlCmdSql
            .CommandText = Array("SELECT * FROM [" & myName & "]")
            i = i + 1
            On Error Resume Next 'Error from the day without currency data.
            .Refresh BackgroundQuery:=False
            On Error GoTo -1
        End With
        Call sbDel_Query 'Delete the query to save time.
        j = j + 1
        If j = 15 Then
            Call sbCleanTables 'Delete Tables to save time.
            j = 0
        End If
    Next myName
    Call sbFormatData 'format the result data
    myTimer = Int((Now() - myTimer) * 24 * 60 * 60)
    MsgBox "Take " & myTimer & " seconds."
End Sub

Sub sbCleanTables()
    'Copy Tables' data, and paste values, then delete Tables.
    Columns("H:M").Copy
    Range("A1").PasteSpecial Paste:=xlPasteValues
    Columns("H:M").Delete Shift:=xlToLeft
    Columns("A:G").Insert Shift:=xlToRight
End Sub

Sub sbDel_Query()
    'Delete all queries and connections
    For Each e In ThisWorkbook.Queries
        e.Delete
    Next e
    For Each e In ThisWorkbook.Connections
        e.Delete
    Next e
End Sub
Sub sbFormatData()
    'format the result data
    'copy Tables to A1:F1
    Columns("H:M").Copy
    Range("A1").PasteSpecial Paste:=xlPasteValues
    'the titles of data
    Range("A1:F1") = Array("Date", "Currency", "Cash (Sell)", "Cash (Buy)", "Transfer (Sell)", "Transfer (Buy)")
    'delete Tables
    Columns("H:M").Delete Shift:=xlToLeft
    'Filter Dates
    Columns("A:F").AutoFilter Field:=1, Criteria1:=">=1"
    Columns("A:F").Copy
    Columns("G:L").PasteSpecial Paste:=xlPasteValues
    Columns("A:F").Delete Shift:=xlToLeft

    Range("A1").CurrentRegion.Select
    Selection.HorizontalAlignment = xlCenter
    Selection.Borders.LineStyle = xlContinuous
    Columns("A").NumberFormatLocal = "yyyy/m/d;@"
    Columns("A:F").EntireColumn.AutoFit
    Range("A1").Select
End Sub

 

[Yugadi Luitel]

Such a genius you are!!! Thank you so much for your help