Web Query in VBA Loop through tables on page to choose get tags from table instead of text

Shloime · Jul 25, 2024

I have a macro to get the last working day of last month, to check if it's a bank holiday (UK, England) I tried to do with a web query, there are a few issues with it
1) It takes the text which Doesn't have the year is there any way to get the date from the row in html table on web page?, <time datetime="2023-12-26">26 December</time>
2)there mast be a more efficient way with the query I want to get all tables for ENGLAND AND WALES
3)do you have any other vba code to check for bank holidays

Below is the code I have:

VBA Code:

Dim DT As String
Dim lastWorkingDay As Date
Dim WS As Worksheet

Sub UpdateDate()
BankHoliday
For i = 1 To 88
lastWorkingDay = DateSerial(Year(Date), Month(Date), 1) - i
'lastWorkingDay = DateSerial(Year(Date), 5, 1) - 1
Do While Weekday(lastWorkingDay) = vbSaturday Or Weekday(lastWorkingDay) = vbSunday Or IsNumeric(Application.Match(lastWorkingDay, WS.ListObjects(1).ListColumns(1).DataBodyRange, 0))
lastWorkingDay = lastWorkingDay - 1
Loop
DT = Format(lastWorkingDay, "dddd d""" & GetSuffix(day(lastWorkingDay)) & """ MMMM yyyy")

Debug.Print DT
Next
End Sub
Function GetSuffix(day As Integer) As String
Select Case day
Case 1, 21, 31
GetSuffix = "st"
Case 2, 22
GetSuffix = "nd"
Case 3, 23
GetSuffix = "rd"
Case Else
GetSuffix = "th"
End Select
End Function
Sub BankHoliday()
Dim WB As Workbook
Set WB = Workbooks.Add ' name:="Temp.xlsx"
'WB.SaveAs (ThisWorkbook.Path & "\Temp.xlsx")
WB.Queries.Add Name:= _
"Upcoming bank holidays in England and Wales 2024", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Web.BrowserContents(""UK bank holidays"")," & Chr(13) & "" & Chr(10) & " #""Extracted Table From Html"" = Html.Table(Source, {{""Column1"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(3) > TABLE.gem-c-table.govuk-table > * > TR > :nth-child(1)""}, {""Column2"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(3) > TABLE." & _
"gem-c-table.govuk-table > * > TR > :nth-child(2)""}, {""Column3"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(3) > TABLE.gem-c-table.govuk-table > * > TR > :nth-child(3)""}}, [RowSelector=""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(3) > TABLE.gem-c-table.govuk-table > * > TR""])," & Chr(13) & "" & Chr(10) & " #""Promoted Headers"" = Table.PromoteHe" & _
"aders(#""Extracted Table From Html"", [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(#""Promoted Headers"",{{""Date"", type date}, {""Day of the week"", type text}, {""Bank holiday"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""
WB.Queries.Add Name:= _
"Upcoming bank holidays in England and Wales 2025", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Web.BrowserContents(""UK bank holidays"")," & Chr(13) & "" & Chr(10) & " #""Extracted Table From Html"" = Html.Table(Source, {{""Column1"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(4) > TABLE.gem-c-table.govuk-table > * > TR > :nth-child(1)""}, {""Column2"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(4) > TABLE." & _
"gem-c-table.govuk-table > * > TR > :nth-child(2)""}, {""Column3"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(4) > TABLE.gem-c-table.govuk-table > * > TR > :nth-child(3)""}}, [RowSelector=""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(4) > TABLE.gem-c-table.govuk-table > * > TR""])," & Chr(13) & "" & Chr(10) & " #""Promoted Headers"" = Table.PromoteHe" & _
"aders(#""Extracted Table From Html"", [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(#""Promoted Headers"",{{""Date"", type date}, {""Day of the week"", type text}, {""Bank holiday"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""
WB.Queries.Add Name:= _
"Upcoming bank holidays in England and Wales 2026", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Web.BrowserContents(""UK bank holidays"")," & Chr(13) & "" & Chr(10) & " #""Extracted Table From Html"" = Html.Table(Source, {{""Column1"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(5) > TABLE.gem-c-table.govuk-table > * > TR > :nth-child(1)""}, {""Column2"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(5) > TABLE." & _
"gem-c-table.govuk-table > * > TR > :nth-child(2)""}, {""Column3"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(5) > TABLE.gem-c-table.govuk-table > * > TR > :nth-child(3)""}}, [RowSelector=""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(5) > TABLE.gem-c-table.govuk-table > * > TR""])," & Chr(13) & "" & Chr(10) & " #""Promoted Headers"" = Table.PromoteHe" & _
"aders(#""Extracted Table From Html"", [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(#""Promoted Headers"",{{""Date"", type date}, {""Day of the week"", type text}, {""Bank holiday"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""
WB.Queries.Add Name:= _
"Past bank holidays in England and Wales 2024", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Web.BrowserContents(""UK bank holidays"")," & Chr(13) & "" & Chr(10) & " #""Extracted Table From Html"" = Html.Table(Source, {{""Column1"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(12) > TABLE.gem-c-table.govuk-table > * > TR > :nth-child(1)""}, {""Column2"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(12) > TABL" & _
"E.gem-c-table.govuk-table > * > TR > :nth-child(2)""}, {""Column3"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(12) > TABLE.gem-c-table.govuk-table > * > TR > :nth-child(3)""}}, [RowSelector=""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(12) > TABLE.gem-c-table.govuk-table > * > TR""])," & Chr(13) & "" & Chr(10) & " #""Promoted Headers"" = Table.Promo" & _
"teHeaders(#""Extracted Table From Html"", [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(#""Promoted Headers"",{{""Date"", type date}, {""Day of the week"", type text}, {""Bank holiday"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""
WB.Queries.Add Name:= _
"Past bank holidays in England and Wales 2023", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Web.BrowserContents(""UK bank holidays"")," & Chr(13) & "" & Chr(10) & " #""Extracted Table From Html"" = Html.Table(Source, {{""Column1"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(13) > TABLE.gem-c-table.govuk-table > * > TR > :nth-child(1)""}, {""Column2"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(13) > TABL" & _
"E.gem-c-table.govuk-table > * > TR > :nth-child(2)""}, {""Column3"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(13) > TABLE.gem-c-table.govuk-table > * > TR > :nth-child(3)""}}, [RowSelector=""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(13) > TABLE.gem-c-table.govuk-table > * > TR""])," & Chr(13) & "" & Chr(10) & " #""Promoted Headers"" = Table.Promo" & _
"teHeaders(#""Extracted Table From Html"", [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(#""Promoted Headers"",{{""Date"", type date}, {""Day of the week"", type text}, {""Bank holiday"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""
WB.Queries.Add Name:= _
"Past bank holidays in England and Wales 2022", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Web.BrowserContents(""UK bank holidays"")," & Chr(13) & "" & Chr(10) & " #""Extracted Table From Html"" = Html.Table(Source, {{""Column1"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(14) > TABLE.gem-c-table.govuk-table > * > TR > :nth-child(1)""}, {""Column2"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(14) > TABL" & _
"E.gem-c-table.govuk-table > * > TR > :nth-child(2)""}, {""Column3"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(14) > TABLE.gem-c-table.govuk-table > * > TR > :nth-child(3)""}}, [RowSelector=""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(14) > TABLE.gem-c-table.govuk-table > * > TR""])," & Chr(13) & "" & Chr(10) & " #""Promoted Headers"" = Table.Promo" & _
"teHeaders(#""Extracted Table From Html"", [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(#""Promoted Headers"",{{""Date"", type date}, {""Day of the week"", type text}, {""Bank holiday"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""
WB.Queries.Add Name:= _
"Past bank holidays in England and Wales 2021", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Web.BrowserContents(""UK bank holidays"")," & Chr(13) & "" & Chr(10) & " #""Extracted Table From Html"" = Html.Table(Source, {{""Column1"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(15) > TABLE.gem-c-table.govuk-table > * > TR > :nth-child(1)""}, {""Column2"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(15) > TABL" & _
"E.gem-c-table.govuk-table > * > TR > :nth-child(2)""}, {""Column3"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(15) > TABLE.gem-c-table.govuk-table > * > TR > :nth-child(3)""}}, [RowSelector=""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(15) > TABLE.gem-c-table.govuk-table > * > TR""])," & Chr(13) & "" & Chr(10) & " #""Promoted Headers"" = Table.Promo" & _
"teHeaders(#""Extracted Table From Html"", [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(#""Promoted Headers"",{{""Date"", type date}, {""Day of the week"", type text}, {""Bank holiday"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""
WB.Queries.Add Name:= _
"Past bank holidays in England and Wales 2020", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Web.BrowserContents(""UK bank holidays"")," & Chr(13) & "" & Chr(10) & " #""Extracted Table From Html"" = Html.Table(Source, {{""Column1"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(16) > TABLE.gem-c-table.govuk-table > * > TR > :nth-child(1)""}, {""Column2"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(16) > TABL" & _
"E.gem-c-table.govuk-table > * > TR > :nth-child(2)""}, {""Column3"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(16) > TABLE.gem-c-table.govuk-table > * > TR > :nth-child(3)""}}, [RowSelector=""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(16) > TABLE.gem-c-table.govuk-table > * > TR""])," & Chr(13) & "" & Chr(10) & " #""Promoted Headers"" = Table.Promo" & _
"teHeaders(#""Extracted Table From Html"", [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(#""Promoted Headers"",{{""Date"", type date}, {""Day of the week"", type text}, {""Bank holiday"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""
WB.Queries.Add Name:= _
"Past bank holidays in England and Wales 2019", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Web.BrowserContents(""UK bank holidays"")," & Chr(13) & "" & Chr(10) & " #""Extracted Table From Html"" = Html.Table(Source, {{""Column1"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(17) > TABLE.gem-c-table.govuk-table > * > TR > :nth-child(1)""}, {""Column2"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(17) > TABL" & _
"E.gem-c-table.govuk-table > * > TR > :nth-child(2)""}, {""Column3"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(17) > TABLE.gem-c-table.govuk-table > * > TR > :nth-child(3)""}}, [RowSelector=""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(17) > TABLE.gem-c-table.govuk-table > * > TR""])," & Chr(13) & "" & Chr(10) & " #""Promoted Headers"" = Table.Promo" & _
"teHeaders(#""Extracted Table From Html"", [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(#""Promoted Headers"",{{""Date"", type date}, {""Day of the week"", type text}, {""Bank holiday"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""
WB.Queries.Add Name:= _
"Past bank holidays in England and Wales 2018", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Web.BrowserContents(""UK bank holidays"")," & Chr(13) & "" & Chr(10) & " #""Extracted Table From Html"" = Html.Table(Source, {{""Column1"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(18) > TABLE.gem-c-table.govuk-table > * > TR > :nth-child(1)""}, {""Column2"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(18) > TABL" & _
"E.gem-c-table.govuk-table > * > TR > :nth-child(2)""}, {""Column3"", ""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(18) > TABLE.gem-c-table.govuk-table > * > TR > :nth-child(3)""}}, [RowSelector=""SECTION[id='england-and-wales'] > DIV.app-c-calendar:nth-child(18) > TABLE.gem-c-table.govuk-table > * > TR""])," & Chr(13) & "" & Chr(10) & " #""Promoted Headers"" = Table.Promo" & _
"teHeaders(#""Extracted Table From Html"", [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(#""Promoted Headers"",{{""Date"", type date}, {""Day of the week"", type text}, {""Bank holiday"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""
WB.Connections.Add2 _
"Query - Upcoming bank holidays in England and Wales 2024", _
"Connection to the 'Upcoming bank holidays in England and Wales 2024' query in the workbook." _
, _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Upcoming bank holidays in England and Wales 2024;Extended Properties=" _
, """Upcoming bank holidays in England and Wales 2024""", 6, True, False
WB.Connections.Add2 _
"Query - Upcoming bank holidays in England and Wales 2025", _
"Connection to the 'Upcoming bank holidays in England and Wales 2025' query in the workbook." _
, _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Upcoming bank holidays in England and Wales 2025;Extended Properties=" _
, """Upcoming bank holidays in England and Wales 2025""", 6, True, False
WB.Connections.Add2 _
"Query - Upcoming bank holidays in England and Wales 2026", _
"Connection to the 'Upcoming bank holidays in England and Wales 2026' query in the workbook." _
, _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Upcoming bank holidays in England and Wales 2026;Extended Properties=" _
, """Upcoming bank holidays in England and Wales 2026""", 6, True, False
WB.Connections.Add2 _
"Query - Past bank holidays in England and Wales 2024", _
"Connection to the 'Past bank holidays in England and Wales 2024' query in the workbook." _
, _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Past bank holidays in England and Wales 2024;Extended Properties=" _
, """Past bank holidays in England and Wales 2024""", 6, True, False
WB.Connections.Add2 _
"Query - Past bank holidays in England and Wales 2023", _
"Connection to the 'Past bank holidays in England and Wales 2023' query in the workbook." _
, _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Past bank holidays in England and Wales 2023;Extended Properties=" _
, """Past bank holidays in England and Wales 2023""", 6, True, False
WB.Connections.Add2 _
"Query - Past bank holidays in England and Wales 2022", _
"Connection to the 'Past bank holidays in England and Wales 2022' query in the workbook." _
, _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Past bank holidays in England and Wales 2022;Extended Properties=" _
, """Past bank holidays in England and Wales 2022""", 6, True, False
WB.Connections.Add2 _
"Query - Past bank holidays in England and Wales 2021", _
"Connection to the 'Past bank holidays in England and Wales 2021' query in the workbook." _
, _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Past bank holidays in England and Wales 2021;Extended Properties=" _
, """Past bank holidays in England and Wales 2021""", 6, True, False
WB.Connections.Add2 _
"Query - Past bank holidays in England and Wales 2020", _
"Connection to the 'Past bank holidays in England and Wales 2020' query in the workbook." _
, _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Past bank holidays in England and Wales 2020;Extended Properties=" _
, """Past bank holidays in England and Wales 2020""", 6, True, False
WB.Connections.Add2 _
"Query - Past bank holidays in England and Wales 2019", _
"Connection to the 'Past bank holidays in England and Wales 2019' query in the workbook." _
, _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Past bank holidays in England and Wales 2019;Extended Properties=" _
, """Past bank holidays in England and Wales 2019""", 6, True, False
WB.Connections.Add2 _
"Query - Past bank holidays in England and Wales 2018", _
"Connection to the 'Past bank holidays in England and Wales 2018' query in the workbook." _
, _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Past bank holidays in England and Wales 2018;Extended Properties=" _
, """Past bank holidays in England and Wales 2018""", 6, True, False

'Windows("Book10").Activate
WB.Queries.Add Name:="Append1", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Table.Combine({#""Upcoming bank holidays in England and Wales 2024"", #""Upcoming bank holidays in England and Wales 2025"", #""Upcoming bank holidays in England and Wales 2026"", #""Past bank holidays in England and Wales 2024"", #""Past bank holidays in England and Wales 2023"", #""Past bank holidays in England and Wales 2022"", #""Past bank holi" & _
"days in England and Wales 2021"", #""Past bank holidays in England and Wales 2020"", #""Past bank holidays in England and Wales 2019"", #""Past bank holidays in England and Wales 2018""})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " Source" & _
""
Set WS = WB.Worksheets.Add
With WS.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Append1;Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Append1]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Append1"
.Refresh BackgroundQuery:=False
End With
End Sub

Domenic · Jul 25, 2024

Try the following...

VBA Code:

Option Explicit

Sub test()

    'Set a reference (VBE > Tools > References) to the following libraries:
    '   1) Microsoft XML, v6.0
    '   2) Microsoft HTML Object Library

    Dim destWorksheet As Worksheet
    Dim req As MSXML2.XMLHTTP60
    Dim doc As MSHTML.HTMLDocument
    Dim tables As MSHTML.IHTMLElementCollection
    Dim table As MSHTML.IHTMLTable
    Dim tableRows As MSHTML.IHTMLElementCollection
    Dim tableIndex As Long
    Dim tableRowIndex As Long
    Dim sheetRowIndex As Long
    Dim url As String
    Dim resp As String
    
    url = "https://www.gov.uk/bank-holidays"
    
    Set req = New MSXML2.XMLHTTP60
    
    With req
        .Open "GET", url, False
        .send
        If .Status <> 200 Then
            MsgBox "Error " & .Status & ":  " & .statusText
            Exit Sub
        End If
        resp = .responseText
    End With
    
    Set destWorksheet = ThisWorkbook.Worksheets.Add
    
    destWorksheet.Range("A1:C1").Value = Array("Date", "Day of the week", "Bank holiday")
    
    Set doc = New MSHTML.HTMLDocument
    
    doc.body.innerHTML = resp
    
    Set tables = doc.getElementById("england-and-wales").getElementsByTagName("table")
    
    sheetRowIndex = 2
    With tables
        For tableIndex = 0 To .Length - 1
            Set table = .Item(tableIndex)
            Set tableRows = table.getElementsByTagName("tr")
            With tableRows
                For tableRowIndex = 1 To .Length - 1
                    destWorksheet.Cells(sheetRowIndex, "A").Value = .Item(tableRowIndex).getElementsByTagName("time")(0).getAttribute("datetime")
                    destWorksheet.Cells(sheetRowIndex, "B").Value = .Item(tableRowIndex).Cells(1).innerText
                    destWorksheet.Cells(sheetRowIndex, "C").Value = .Item(tableRowIndex).Cells(2).innerText
                    sheetRowIndex = sheetRowIndex + 1
                Next tableRowIndex
            End With
        Next tableIndex
    End With
    
    Set req = Nothing
    Set doc = Nothing
    Set tables = Nothing
    Set table = Nothing
    Set tableRows = Nothing

End Sub

Results...

shloime.xlsm

A

B

C

1

Date

Day of the week

Bank holiday

2

8/26/2024

Monday

Summer bank holiday

3

12/25/2024

Wednesday

Christmas Day

4

12/26/2024

Thursday

Boxing Day

5

1/1/2025

Wednesday

New Year’s Day

6

4/18/2025

Friday

Good Friday

7

4/21/2025

Monday

Easter Monday

8

5/5/2025

Monday

Early May bank holiday

9

5/26/2025

Monday

Spring bank holiday

10

8/25/2025

Monday

Summer bank holiday

11

12/25/2025

Thursday

Christmas Day

12

12/26/2025

Friday

Boxing Day

13

1/1/2026

Thursday

New Year’s Day

14

4/3/2026

Friday

Good Friday

15

4/6/2026

Monday

Easter Monday

16

5/4/2026

Monday

Early May bank holiday

17

5/25/2026

Monday

Spring bank holiday

18

8/31/2026

Monday

Summer bank holiday

19

12/25/2026

Friday

Christmas Day

20

12/28/2026

Monday

Boxing Day (substitute day)

21

5/27/2024

Monday

Spring bank holiday

22

5/6/2024

Monday

Early May bank holiday

23

4/1/2024

Monday

Easter Monday

24

3/29/2024

Friday

Good Friday

25

1/1/2024

Monday

New Year’s Day

26

12/26/2023

Tuesday

Boxing Day

27

12/25/2023

Monday

Christmas Day

28

8/28/2023

Monday

Summer bank holiday

29

5/29/2023

Monday

Spring bank holiday

30

5/8/2023

Monday

Bank holiday for the coronation of King Charles III

31

5/1/2023

Monday

Early May bank holiday

32

4/10/2023

Monday

Easter Monday

33

4/7/2023

Friday

Good Friday

34

1/2/2023

Monday

New Year’s Day (substitute day)

35

12/27/2022

Tuesday

Christmas Day (substitute day)

36

12/26/2022

Monday

Boxing Day

37

9/19/2022

Monday

Bank Holiday for the State Funeral of Queen Elizabeth II

38

8/29/2022

Monday

Summer bank holiday

39

6/3/2022

Friday

Platinum Jubilee bank holiday

40

6/2/2022

Thursday

Spring bank holiday

41

5/2/2022

Monday

Early May bank holiday

42

4/18/2022

Monday

Easter Monday

43

4/15/2022

Friday

Good Friday

44

1/3/2022

Monday

New Year’s Day (substitute day)

45

12/28/2021

Tuesday

Boxing Day (substitute day)

46

12/27/2021

Monday

Christmas Day (substitute day)

47

8/30/2021

Monday

Summer bank holiday

48

5/31/2021

Monday

Spring bank holiday

49

5/3/2021

Monday

Early May bank holiday

50

4/5/2021

Monday

Easter Monday

51

4/2/2021

Friday

Good Friday

52

1/1/2021

Friday

New Year’s Day

53

12/28/2020

Monday

Boxing Day (substitute day)

54

12/25/2020

Friday

Christmas Day

55

8/31/2020

Monday

Summer bank holiday

56

5/25/2020

Monday

Spring bank holiday

57

5/8/2020

Friday

Early May bank holiday (VE day)

58

4/13/2020

Monday

Easter Monday

59

4/10/2020

Friday

Good Friday

60

1/1/2020

Wednesday

New Year’s Day

61

12/26/2019

Thursday

Boxing Day

62

12/25/2019

Wednesday

Christmas Day

63

8/26/2019

Monday

Summer bank holiday

64

5/27/2019

Monday

Spring bank holiday

65

5/6/2019

Monday

Early May bank holiday

66

4/22/2019

Monday

Easter Monday

67

4/19/2019

Friday

Good Friday

68

1/1/2019

Tuesday

New Year’s Day

69

12/26/2018

Wednesday

Boxing Day

70

12/25/2018

Tuesday

Christmas Day

71

8/27/2018

Monday

Summer bank holiday

72

5/28/2018

Monday

Spring bank holiday

73

5/7/2018

Monday

Early May bank holiday

74

4/2/2018

Monday

Easter Monday

75

3/30/2018

Friday

Good Friday

76

1/1/2018

Monday

New Year’s Day

Sheet1

Hope this helps!

Shloime · Aug 1, 2024

Thanks "Domenic" for the solution this works
maybe there's a more efficient way using https://www.gov.uk/bank-holidays.json
also I's like to add to an array/dictionary to be used also in word vba and test if a date exist there

Domenic · Aug 1, 2024

Yes, that should be more efficient. In that case, if you don't already have it, first download the JSON parser from the following link and add it to your workbook...

GitHub - VBA-tools/VBA-JSON: JSON conversion and parsing for VBA

Then try to adapt the following code...

VBA Code:

Sub test()

    'Set a reference (VBE > Tools > References) to the following libraries:
    '   1) Microsoft XML, v6.0
    '   2) Microsoft Scripting Runtime

    Dim xmlReq As MSXML2.XMLHTTP60
    Dim dic As Scripting.Dictionary
    Dim colEvents As VBA.Collection
    Dim dicEvent As Scripting.Dictionary
    Dim item As Object
    Dim strURL As String
    Dim strResp As String
 
    strURL = "https://www.gov.uk/bank-holidays.json"
 
    Set xmlReq = New MSXML2.XMLHTTP60
 
    With xmlReq
        .Open "GET", strURL, False
        .send
        If .Status <> 200 Then
            MsgBox "Error " & .Status & ":  " & .statusText
            Exit Sub
        End If
        strResp = .responseText
    End With
 
    Set dic = JsonConverter.ParseJson(strResp)
 
    Set colEvents = dic("england-and-wales")("events")
 
    For Each item In colEvents
        Set dicEvent = item
        Debug.Print dicEvent("date"), dicEvent("title")
    Next item
 
    Set xmlReq = Nothing
    Set dic = Nothing
    Set colEvents = Nothing
    Set dicEvent = Nothing

End Sub

Results...

Excel Formula:

2018-01-01    New Year’s Day
2018-03-30    Good Friday
2018-04-02    Easter Monday
2018-05-07    Early May bank holiday
2018-05-28    Spring bank holiday
2018-08-27    Summer bank holiday
2018-12-25    Christmas Day
2018-12-26    Boxing Day
2019-01-01    New Year’s Day
2019-04-19    Good Friday
etc.
'
'
'

Hope this helps!

Shloime · Aug 1, 2024

I found this JSON converter when searching I wouldn't say I like it because if I send a file with this code to someone else I'd need to get them to download the file.
there should be a solution working only with already built in program
like this:

VBA Code:

Sub CheckBankHoliday()
Dim Req As Object
Dim URL As String, Resp
Dim S As Integer, E, A, DT
Dim D As Object
Dim Ar() As String
 Set D = CreateObject("Scripting.Dictionary")
URL = "https://www.gov.uk/bank-holidays.json"
Set Req = CreateObject("MSXML2.XMLHTTP")
Req.Open "GET", URL, False
Req.send
If Req.Status <> 200 Then
    MsgBox Req.Status & " - " & Req.statusText
    Exit Sub
End If
'Remove the quotes
Resp = Replace(Req.responseText, Chr(34), "")
'get only England and Wales start and end
S = InStr(1, Resp, "[")
E = InStr(1, Resp, "]")
Resp = Replace(Replace(Mid(Resp, S + 8, E - S), "{", ""), "}", "")

'array with 1 line for every holiday day (I didn't find a way to split into a 2 dimensional array)
Ar = Split(Resp, ",title:")

For A = LBound(Ar) To UBound(Ar)
D.Add Key:=CDate(Replace(Split(Ar(A), ",")(1), "date:", "")), Item:=Split(Ar(A), ",")(0)
Next
'test---------
    For DT = 1 To 365
    If D.Exists(DateSerial(2024, 1, 1) - 1 + DT) Then Debug.Print D(DateSerial(2024, 1, 1) - 1 + DT)
    Next
Set Req = Nothing
End Sub

Domenic · Aug 1, 2024

Actually, no... others will not need to download the code for the JSON parser. Once you've added the code to your workbook, along with the required references, you can forward the workbook to others, and they can simply open it, and run the macro.

However, since you're going to be sending the workbook to other users, there is one concern. That's if a user has an older version of the XML object library, instead of v6.0. For this reason, you should use late binding, instead of early binding. If you need help with converting the code to late binding, post back and I'll be happy to help.

Shloime · Aug 2, 2024

how is the data added to the workbook? where is it saved? and what if it's a Word document the last code I copied here works in Word as well
I used in the above code

VBA Code:

Set Req = CreateObject("MSXML2.XMLHTTP")

would this go with any version?

Domenic · Aug 2, 2024

The following code retrieves the bank holidays for the specified division, which in this case is "england-and-wales". Then it creates a new worksheet, and writes the dates and corresponding holidays. Notice that it uses late binding, instead of early binding. So there's no need to set a reference.

VBA Code:

Option Explicit

Sub List_Bank_Holidays()

    Dim url As String
    Dim division As String
    Dim errorMessage As String
    Dim dicBankHolidays As Object
    Dim resultsWorksheet As Worksheet
   
    url = "https://www.gov.uk/bank-holidays.json"
   
    division = "england-and-wales"
   
    errorMessage = ""
   
    Set dicBankHolidays = getBankHolidays(url, division, errorMessage)
   
    If dicBankHolidays Is Nothing Then
        MsgBox errorMessage, vbCritical, "Error"
        Exit Sub
    End If
   
    Set resultsWorksheet = ThisWorkbook.Worksheets.Add
   
    With resultsWorksheet
        .Range("A1:B1").Value = Array("Date", "Bank Holiday")
        .Range("A2").Resize(dicBankHolidays.Count).Value = Application.Transpose(dicBankHolidays.Keys())
        .Range("B2").Resize(dicBankHolidays.Count).Value = Application.Transpose(dicBankHolidays.Items())
    End With
   
    Set dicBankHolidays = Nothing
    Set resultsWorksheet = Nothing
   
End Sub

Private Function getBankHolidays(ByVal url As String, ByVal division As String, ByRef errorMessage As String) As Object

    Dim xmlReq As Object
    Dim dicMain As Object
    Dim dicResults As Object
    Dim colEvents As Collection
    Dim dicEvent As Object
    Dim item As Object
    Dim resp As String
   
    Set xmlReq = CreateObject("MSXML2.XMLHTTP")
   
    With xmlReq
        .Open "GET", url, False
        .send
        If .Status <> 200 Then
            errorMessage = "Error " & .Status & ":  " & .statusText
            Set getBankHolidays = Nothing
            Exit Function
        End If
        resp = .responseText
    End With
   
    Set dicResults = CreateObject("Scripting.Dictionary")
   
    Set dicMain = JsonConverter.ParseJson(resp)
   
    Set colEvents = dicMain(division)("events")
   
    For Each item In colEvents
        Set dicEvent = item
        dicResults.Add Key:=dicEvent("date"), item:=dicEvent("title")
    Next item
   
    Set getBankHolidays = dicResults
   
    Set xmlReq = Nothing
    Set dicMain = Nothing
    Set dicResults = Nothing
    Set colEvents = Nothing
    Set dicEvent = Nothing

End Function

Results...



Date	Bank Holiday
1/1/2018	New Year’s Day
3/30/2018	Good Friday
4/2/2018	Easter Monday
5/7/2018	Early May bank holiday
5/28/2018	Spring bank holiday
8/27/2018	Summer bank holiday
12/25/2018	Christmas Day
12/26/2018	Boxing Day
1/1/2019	New Year’s Day
4/19/2019	Good Friday
4/22/2019	Easter Monday
5/6/2019	Early May bank holiday
5/27/2019	Spring bank holiday
8/26/2019	Summer bank holiday
12/25/2019	Christmas Day
etc . . .	etc . . .

Hope this helps!

Shloime · Aug 4, 2024

This would also require to download the json converter, right?

Domenic · Aug 4, 2024

Yes that's correct . . .

Web Query in VBA Loop through tables on page to choose get tags from table instead of text

Shloime

New Member

Excel Facts

Domenic

MrExcel MVP

Shloime

New Member

Domenic

MrExcel MVP

Shloime

New Member

Domenic

MrExcel MVP

Shloime

New Member

Domenic

MrExcel MVP

Shloime

New Member

Domenic

MrExcel MVP

Similar threads

Forum statistics

Share this page

Web Query in VBA Loop through tables on page to choose get tags from table instead of text

New Member

Excel Facts

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock