Dictionary key assignment row wise - excel

Question

I have Dictionary objects Dic1,Dic2, whose Items are an alphabet. Say
Dic1(10)= A
Dic1(111)= B
Dic1(12)= C like this.
Dic2(125)= A
Dic2(131)= B
Dic2(126)= C like this.
Now I am trying to assign their keys through a loop in Excel row(3rd column onwards) by below,but not all keys are getting copied.
objSheet2.Range("C"&nRow).Value=Dic1.Keys() Or(condition wise any of the assignment
will be executed)
objSheet2.Range("C"&nRow).Value=Dic2.Keys()
But only the first Key value is getting copied,ignoring the other. Can you tell what the Bug is in my code?
Edit
Option Explicit
Class cP
Public m_sRel
Public m_dicC
Private Sub Class_Initialize()
m_sRel = "Child"
Set m_dicC = CreateObject("Scripting.Dictionary")
End Sub
Public Function show()
show = m_sRel & " " & Join(m_dicC.Keys)
End Function
End Class
Dim objSheet1,objSheet2,TotalRows,TotalcolCopy,strPathExcel1
'Dim oFS : Set oFS = CreateObject("Scripting.FileSystemObject")
Dim oXls : Set oXls = CreateObject("Excel.Application")
'Dim aData ': aData = oWb.Worksheets(1).Range("$A2:$C10")
Dim dicP : Set dicP = CreateObject("Scripting.Dictionary")
Dim nRow,nP,sKeys
strPathExcel1 = "D:\WIPData\AravoMacro\Finalscripts\A.xlsx"
oXls.Workbooks.open strPathExcel1
'oXls.Workbooks.Open(oFs.GetAbsolutePathName("A.xlsx"))
Set objSheet1 = oXls.ActiveWorkbook.Worksheets("WingToWingMay25")
Set objSheet2 = oXls.ActiveWorkbook.Worksheets("ParentChildLink")
TotalRows=oXls.Application.WorksheetFunction.CountA(objSheet1.Columns(1))
TotalcolCopy=oXls.Application.WorksheetFunction.Match("Parent Business Process ID", objSheet1.Rows(3), 0)
objSheet1.Range(objSheet1.Cells(4,1),objSheet1.Cells(TotalRows,TotalcolCopy)).Copy(objSheet2.Range("A1"))
objSheet2.Range(objSheet2.Cells(1,2),objSheet2.Cells(TotalRows,TotalcolCopy-1)).Delete(-4159)
'Dim aData : aData=objSheet2.Cells.SpecialCells(12)'xlCellTypeVisible
Dim aData : aData = objSheet2.Range("A1:B"&TotalRows-3)
'MsgBox(LBound(aData, 1)&"And"&UBound(aData, 1))
For nRow = LBound(aData, 1) To UBound(aData, 1)
Set dicP(aData(nRow, 1)) = New cP
'Set dicP(aData(nRow, 2)) = New cP
Next
'objSheet2.Cells.ClearContents'To clear all the previous contenets of the sheet#2
'sKeys=dicP.Keys
'objSheet2.Range("A1").Resize(dicP.Count) = oXls.Application.Transpose(sKeys)
'MsgBox(dicP.Count&":"&UBound(aData, 1)&":"&LBound(aData, 1))
For nRow = LBound(aData, 1) To UBound(aData, 1)
If aData(nRow, 1) = aData(nRow, 2) Then
dicP(aData(nRow, 1)).m_sRel = "Parent"
Else
If dicP.Exists(aData(nRow, 2)) Then
dicP(aData(nRow, 2)).m_dicC.Add aData(nRow, 1), 0 '(aData(nRow, 1)) = 0
End If
End If
Next
objSheet2.Cells.ClearContents'To clear all the previous contenets of the sheet#2
nRow=1
For Each nP In dicP.Keys()
objSheet2.Cells(nRow,1).Value=nP
objSheet2.Cells(nRow,2).Value=dicP(nP).m_sRel
objSheet2.Range("C"&nRow).Resize(1+ UBound(dicP(nP).m_dicC.Keys()) + 1).Value=dicP(nP).m_dicC.Keys()
'Range("C" & nRow).Resize(1, UBound(d.Keys()) + 1).Value = d.Keys()
nRow=nRow+1
Next
I am getting an error as Unknown Run time error at the line objSheet2.Range("C"&nRow).Resize(1+ UBound(dicP(nP).m_dicC.Keys()) + 1).Value=dicP(nP).m_dicC.Keys()
Thanks,

Answer 1

Yes, you assign an array only to one cell. Then only the first value is copied in.
You have to assign the array to a range of the right size. This can be done with Range.Resize.
Then again, Excel treats the array as a 2-dimensional array (a matrix), and if it is only one-dimensional, this will always be the seen as the first row. If you copy this into a vertical range, each cell will have the same first element of your array.
For a vertical range, you have to transpose your array/virtual matrix:
Sub test()
Dim d
Dim nRow As Long
nRow = 3
Set d = CreateObject("Scripting.Dictionary")
d(1) = "A"
d(2) = "B"
d(17) = "C"
d(32) = "F"
' horizontal:
Range("C" & nRow).Resize(1, UBound(d.Keys()) + 1).Value = d.Keys()
' vertical insert needs the data transformed
Range("C" & nRow).Resize(UBound(d.Keys()) + 1).Value = WorksheetFunction.Transpose(d.Keys())
End Sub
For your edit, you may first of all need to correct ("C"&nRow) to ("C" & nRow). The spaces are required.
Another error is Resize(1 + ... + 1), so you add +2, but this should not throw an error.