Hi,
You need to use Set with an object assignment
Set WorkBooks_Looping = Dict_People
It appears you want to populate dictionar with the result, so
Sub download_zlicz()
Dim PathFiles As String
Dim Variable As Integer
Dim Array_Paths As Variant
Dim i As Integer
Dim wbworkbook As Workbook
Dim dictionar As Object
Set dictionar = CreateObject("Scripting.dictionary")
Variable = 3
Array_Paths = MsoFilePicker("Wybierz pliki", PathFiles, Variable)
For i = 1 To UBound(Array_Paths)
Set wbworkbook = Workbooks.Open(Array_Paths(i))
set dictionar = WorkBooks_Looping
Next i
End Sub
and the function is
Function WorkBooks_Looping() As Object
Dim wbMain As Workbook
Dim wsCount As Integer
Set wbMain = ActiveWorkbook
Dim wbworkbook As Worksheet
Dim y As Long
Dim i As Long
Dim ArrayLoop As Variant
Dim Dict_People As Object
Dim coll As New Collection
Dim Dictionary_Child As Object
Dim varArray As Variant
Dim Wylicz As String
Dim z As Long
Dim Count_Dict As Long
Dim Dict_Temp As Object
Set Dictionary_Child = CreateObject("Scripting.dictionary")
wsCount = wbMain.Worksheets.Count
Set wbworkbook = ActiveSheet
For i = 1 To wsCount
If wbMain.Worksheets(i).Name Like "20*" Then
Set wbworkbook = ActiveSheet
Set Dict_People = CreateObject("Scripting.dictionary")
ArrayLoop = wbworkbook.Range(Cells(2, 5), Cells(154, 10))
For y = 1 To UBound(ArrayLoop)
If Len(ArrayLoop(y, 3)) > 1 Then
If Not Dict_People.Exists(ArrayLoop(y, 3)) Then
Dictionary_Child.Add ArrayLoop(y, 3), Nothing
Dictionary_Child.Add ArrayLoop(y, 1), Nothing
Dictionary_Child.Add ArrayLoop(y, 2), Nothing
Dictionary_Child.Add ArrayLoop(y, 6), Nothing
Dict_People.Add ArrayLoop(y, 3), Dictionary_Child
Dim vitems, vkeys As Variant
Set Dictionary_Child = Nothing
Set Dictionary_Child = CreateObject("Scripting.dictionary")
vkeys = Dict_People.Keys
vitems = Dict_People.items
Else
Set Dict_Temp = CreateObject("Scripting.dictionary")
Dict_Temp.Add ArrayLoop(y, 3), Nothing
On Error Resume Next
Dict_Temp.item(ArrayLoop(y, 3)) = Dict_People(ArrayLoop(y, 3)).Keys
vkeys = Dict_Temp.Keys
vitems = Dict_Temp.items
varArray = Application.Index(Dict_Temp.items, 0, 0)
varArray(4) = ArrayLoop(y, 6) + varArray(4)
Dict_People.item(ArrayLoop(y, 3)) = varArray
vkeys = Dict_People.Keys
vitems = Dict_People.items
Set Dict_Temp = Nothing
End If
End If
Next y
End If
Next i
Set WorkBooks_Looping = Dict_People
End Function
It is not (yet) clear what you intend to do with dictionar inside the loop.
Bookmarks