Adding column to VBA loop - excel

Question

i currently have the code below which is pulling the Current Code image (where for each Set and # it's adding the animal), however I would like to add an new column "Color" and be able to have it do the same thing that the current code is doing just with a new column (as shown in Goal for Code Image).
I tried adding the following by I keep getting a debugging error.
output(idx, 4) = items(itemIdx, 2)
If anyone can help I would really appreacite it! Thanks :)
Current Code
Goal for Code
Const SET_NAMES_ROW_START As Long = 6
Const SET_ITEMS_ROW_START As Long = 6
Const SET_NAMES_COL As String = "A"
Const SET_ITEMS_COL As String = "E"
Const OUTPUT_ROW_START As Long = 6
Const OUTPUT_COL As String = "G"
Dim names() As Variant, items() As Variant, output() As Variant
Dim namesCount As Long, itemsCount As Long
Dim idx As Long, nameIdx As Long, itemIdx As Long
'Read the set values.
With Sheet1
names = .Range( _
.Cells(SET_NAMES_ROW_START, SET_NAMES_COL), _
.Cells(.Rows.Count, SET_NAMES_COL).End(xlUp)) _
.Resize(, 2).Value2
items = .Range( _
.Cells(SET_ITEMS_ROW_START, SET_ITEMS_COL), _
.Cells(.Rows.Count, SET_ITEMS_COL).End(xlUp)) _
.Value2
End With
'Dimension the output array.
namesCount = UBound(names, 1)
itemsCount = UBound(items, 1)
ReDim output(1 To namesCount * itemsCount, 1 To 3)
'Populate the output array.
nameIdx = 1
itemIdx = 1
For idx = 1 To namesCount * itemsCount
output(idx, 1) = names(nameIdx, 1)
output(idx, 2) = names(nameIdx, 2)
output(idx, 3) = items(itemIdx, 1)
itemIdx = itemIdx + 1
If itemIdx > itemsCount Then
'Increment the name index by 1.
nameIdx = nameIdx + 1
'Reset the item index to 1.
itemIdx = 1
End If
Next
'Write array to the output sheet.
Sheet1.Cells(OUTPUT_ROW_START, OUTPUT_COL).Resize(UBound(output, 1), UBound(output, 2)).Value = output

Answer 1

Sort of Unpivot
' *** is indicating the differences between this and the initial code.
The Code
Option Explicit
Sub SortOfUnpivot()
Const FirstRow As Long = 6
Const LastRowCol As String = "E"
Const dstFirstCell As String = "H6"
Dim srcCols As Variant
srcCols = VBA.Array("A", "B", "E", "F") ' ***
Dim LB As Long
LB = LBound(srcCols)
Dim UB As Long
UB = UBound(srcCols)
Dim srcCount As Long
srcCount = UB - LB + 1
Dim LastRow As Long
LastRow = Cells(Rows.Count, LastRowCol).End(xlUp).Row
Dim rng As Range
Set rng = Cells(FirstRow, LastRowCol).Resize(LastRow - FirstRow + 1)
Dim Source As Variant
ReDim Source(LB To UB)
Dim j As Long
For j = LB To UB
Source(j) = rng.Offset(, Columns(srcCols(j)).Column - rng.Column).Value
Next j
Dim UBS As Long
UBS = UBound(Source(UB))
Dim Dest As Variant
ReDim Dest(1 To UBS ^ 2, 1 To srcCount)
Dim i As Long
Dim k As Long
For j = 1 To UBS
k = k + 1
For i = 1 + (j - 1) * UBS To UBS + (j - 1) * UBS
Dest(i, 1) = Source(0)(k, 1)
Dest(i, 2) = Source(1)(k, 1)
Dest(i, 3) = Source(2)(i - (j - 1) * UBS, 1)
Dest(i, 4) = Source(3)(i - (j - 1) * UBS, 1) '***
Next i
Next j
Range(dstFirstCell).Resize(UBound(Dest), srcCount).Value = Dest
End Sub