Transpose large amount of Rows by multiple Columns

Hi Forum,
I have a worksheet of data comprised of 3 fields of Values plus a 4th Column containing the Figure Headings and a 5th with the actual Figures for those fields.
I've attached a sample worksheet to show the before and after.
There are about a full worksheet (1,000,000+) of rows to transpose.
I have a couple of examples created by jindon which are great, but now I need to handle more data as I am getting errors when running the code.

I've attached the 2 Macros to show where I'm at:

The first errors due to the number of rows to process and I am getting an error not recognising the source data for the second.

Sub test()
    Dim a, b, i As Long, ii As Long, s As String, n As Long, t As Long
    Dim c1 As New Collection, c2 As New Collection, x
    With Sheets("sheet4")
        With .[a1].CurrentRegion
            a = .Value: b = .Columns(4).Value
        End With
        n = 1: t = 3
        For i = 2 To UBound(a, 1)
            x = a(i, 5): a(i, 5) = 0: a(i, 4) = 0
            On Error Resume Next
            t = t + 1: c2.Add t, b(i, 1)
            If Err Then
                t = t - 1
            Else
                If t > UBound(a, 2) Then
                    ReDim Preserve a(1 To UBound(a, 1), 1 To UBound(a, 2) + 100)
                End If
                a(1, t) = b(i, 1)
            End If
            Err.Clear
            s = Join(Array(a(i, 1), a(i, 2), a(i, 3)), Chr(2))
            n = n + 1: c1.Add n, s
            If Err Then
                n = n - 1
            Else
                For ii = 1 To 3: a(n, ii) = a(i, ii): Next
            End If
            On Error GoTo 0
            a(c1(s), c2(b(i, 1))) = a(c1(s), c2(b(i, 1))) + x  ' Errors at the a(c1(s) part due to the number of records
        Next
        .[g1].Resize(n, t) = a
    End With

Second solution:

Sub testADO()
    Dim cn As Object, rs As Object, i As Long
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    cn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & _
            ";Extended Properties=""Excel 12.0;HDR=Yes;"""
    rs.Open "Transform Sum(`Total`) Select `Type`, `Cat`, `description` From `Sheet4$" & _
            Sheets("sheet4").[a1].CurrentRegion.Address(0, 0) & "` Group By " & _
            "`Type`, `Cat`, `description` Pivot `label`;", cn, 3, 3, 1
    With Sheets("sheet4")
        For i = 0 To rs.Fields.Count - 1
            .Cells(1, i + 7) = rs.Fields(i).Name
        Next
        .Cells(2, 7).CopyFromRecordset rs
    End With
    Set rs = Nothing: Set cn = Nothing
End Sub