Adding column to an array

Hello all,

I have got a VBA code which pulls data from a table on website. This data you can find on sheet called Sheet1. But my desired table i want it to look like is visualised in sheet called Desired. Would it be possible to add two variables to an array from website? The variables I want to add are nowDate, nowTime, cat, website.

Sub DolphinFitness()
 Dim oHtml As HTMLDocument
 Dim oElement As Object
 Dim a, x, i As Long, ii As Long
 Dim nowDate, nowTime As Date
 Dim cat, website As String
 
 nowDate = Format(Now(), "dd/mm/yyyy", vbSunday)
 nowTime = Format(Now(), "hh:mm", vbSunday)
 website = "DolphinFitness"
 cat = "protein-isolate"
 
 'Needs a Reference.
 'Go to Tools > Reference > Search for Microsoft HTML Object Library > tick the checkbox > OK
 Set oHtml = New HTMLDocument
 
 With CreateObject("WINHTTP.WinHTTPRequest.5.1")
    .Open "GET", "http://www.dolphinfitness.co.uk/en/protein-isolate", False
    .send
    oHtml.body.innerHTML = .responseText
    Debug.Print
 End With

 ReDim a(1 To 100000, 1 To 5)
 For Each oElement In oHtml.getElementsByClassName("snapshot")
    i = i + 1
    x = Split(oElement.outerText, vbCr)
    For ii = 1 To UBound(x)
        a(i, ii) = Trim$(x(ii))
    Next
    
 Next oElement
 Sheets("Sheet1").Cells(2, 1).Resize(i, 5) = a
 
 '' remove line breaks
     Dim MyRange As Range
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    For Each MyRange In ActiveSheet.UsedRange
        If 0 < InStr(MyRange, Chr(10)) Then
            MyRange = Replace(MyRange, Chr(10), "")
        End If
    Next
    
'' remove sterling sign
    ActiveSheet.Range("C:C").Replace What:="£", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
 
End Sub