Hello,
my main sub is looking like that:
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))
Call WorkBooks_Looping(dictionar)
Next i
End Sub
In bold code there is reference to function:
Function WorkBooks_Looping(dictionar)
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
WorkBooks_Looping = Dict_People
End Function
So after different countings I have dictionary Dict_People and i want to pass it into my main sub.
Now function WorkBooks_Looping will be empty.
How can i do this?
Please help,
Best Wishes,
Jacek Antek
Bookmarks