Add multiple items to scripting dictionary from one key and keep structure

I have been using a scripting dictionary to extract values in column B based on whether the value in column matches a certain criteria.

I would now like to extract the value in column C as well as B (if A matches vCriteria) and then paste in the same format- currently it transposes into a one-column list- I need to column B & C values to stay adjacent.

here's the current code:

Set oDic = CreateObject("Scripting.Dictionary")
                With Sheets("ExP")
                   vData = .Range("A2:B" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
                End With
                For i = 1 To UBound(vData, 1)
                   If vData(i, 1) = vCriteria2 Then
                      If Not oDic.Exists(CStr(vData(i, 2))) Then oDic.Add CStr(vData(i, 2)), vData(i, 2)
                   End If
                Next i
                     If oDic.Count Then
                        vItems = oDic.items
                          With Sheets("Search").Range("F11").Resize(oDic.Count, 1)
                          .Value = Application.Transpose(vItems)
                             If Not Sheets("Search").Range("F12").Value = "" Then
                                 .Sort key1:=.Cells(1), Header:=xlNo
                             End If
                          End With
                     End If
            End If

thanks guys

strud,
You post part of the code and this code compares column B, not A.
It could easily be resolved if you could attach the sample you used with the above code, and your desired result.

No it compares column A to my vCriteria then adds the value in column B if there is a match.

It doesn't really seem necessary to add a sample workbook I'm just having trouble adding column C as well (if there is a match).

I have changed it to the following- but this produces an error:

 Set oDic = CreateObject("Scripting.Dictionary")
                With Sheets("ExP")
                   vData = .Range("A2:C" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
                End With
                For i = 1 To UBound(vData, 1)
                   If vData(i, 1) = vCriteria2 Then
                      If Not oDic.Exists(CStr(vData(i, 2))) Then oDic.Add CStr(vData(i, 2)), vData(i, 2) And oDic.Add CStr(vData(i, 3)), vData(i, 3)
                   End If

How do I test it then if I can not see the sample?
This will remove the error you are getting, but I doubt if the you get the result.

  If Not oDic.Exists(CStr(vData(i, 2))) Then oDic.Item(CStr(vData(i, 2)))= Array(vData(i, 2), vData(i, 3))

Ah I didn't realise you would need to test it- sorry about that.

here's an example workbook...

You can use:

Sub Generate_List2()
   Dim i                           As Long
   Dim oDic                        As Object
   Dim vItems
   Dim vCriteria
   Dim vData

   Application.ScreenUpdating = False

   vCriteria = Sheets("Sheet1").Range("G1").Value2

   Set oDic = CreateObject("Scripting.Dictionary")
   With Sheets("Sheet1")
      vData = .Range("A2:C" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
   End With
   For i = 1 To UBound(vData, 1)
      If vData(i, 1) = vCriteria Then
         oDic.Item(CStr(vData(i, 2))) = Array(vData(i, 2), vData(i, 3))
      End If
   Next i
        If oDic.Count Then
           vItems = oDic.Items
             With Sheets("Sheet1").Range("F7").Resize(oDic.Count, 2)
             .Value = Application.Index(vItems, 0, 0)
                If Not Sheets("Sheet1").Range("F8").Value = "" Then
                    .Sort key1:=.Cells(1), Header:=xlNo
                End If
             End With
        End If
        
   Application.ScreenUpdating = True
   
End Sub

Try the attached.
Please note there is a space on G1.

thanks guys both solutions work perfectly