Read/Write data in Array

[abc_xyz]

The task is to extract data from the Source File (contains Multiple Source Sheets) based on the key word in the Dashboard column E and paste them into their respective Destination File and Destination Sheet.
For Example: Extract data from the Source Sheet [ABC - Sheet Name] of the Source File and paste them into the Destination Sheet [ABC - Sheet Name] based on the criteria in Dashboard column E.

The below code works fine when ran for an individual Key but gives an error if added it to a loop for each key in Dashboard column E.
Gives error highlighting Nary(nr, c) = Ary(r, c) [Subscription Out of Range - error message] when it tries to extract data for the second key in the loop.

Can anyone please help me solve this?

Sub KeyCuts()


Dim SourceFilePath As String, CountryKey As String, SourceSheet As String, SourceCol As String, CountryName As String, DestinationFilePath As String, DestinationSheet As String, NewSheetName As String, SaveAs_Name As String, SaveAs_Path As String
Dim OpenSource As Workbook, OpenDestination As Workbook
Dim cl As Range
Dim Dic As Object
Dim StartTime As Double
Dim MinutesElapsed As String
Dim Ary As Variant, Nary As Variant
Dim r As Long, c As Long, nr As Long, lastRow As Long




With Application
   .ScreenUpdating = False
   .DisplayAlerts = False
   .EnableEvents = False
End With

StartTime = Timer


lastRow = ThisWorkbook.Sheets("Dashboard").Range("E" & Rows.Count).End(xlUp).row
SourceFilePath = ThisWorkbook.Sheets("Dashboard").Range("F3")



'Open Source/Input File
    Set OpenSource = Workbooks.Open(SourceFilePath)

With ThisWorkbook.Sheets("Dashboard")
   
'Loop through each Country key in Dashboard
For Each cl In .Range("E12", .Range("E" & Rows.Count).End(xlUp))
            
        
'Declare value for placeholder
            CountryKey = cl.value
            SourceSheet = cl.Offset(, 1).value
            SourceCol = cl.Offset(, 2).value ' Column Number
            DestinationFilePath = cl.Offset(, 3).value
            DestinationSheet = cl.Offset(, 4).value
            SaveAs_Name = cl.Offset(, 5).value


'Open Destination File
    Set OpenDestination = Workbooks.Open(DestinationFilePath)


            With OpenSource.Sheets(SourceSheet)

                c = .Cells.Find("*", , , , xlByColumns, xlPrevious, , , False).column
                Ary = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Resize(, c).Value2

            End With
        
        
'Find and add matched cases into another array
            ReDim Nary(1 To UBound(Ary), 1 To c)
            For r = 1 To UBound(Ary)
                If Trim(LCase(Ary(r, SourceCol))) = CountryKey Then
                    nr = nr + 1
                        For c = 1 To UBound(Ary, 2)
                            Nary(nr, c) = Ary(r, c)
                        Next c
                End If
            Next r

                
            With OpenDestination.Sheets(DestinationSheet)
                
                   With .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(nr, UBound(Nary, 2))
                        .NumberFormat = "@"    'Text format
                        .value = Nary
                        .NumberFormat = "General"
                    End With
            
            
                    If SaveAs_Name = "" Then
                    
                    Else
                        .SaveAs "C:\Users\" & ThisWorkbook.Sheets("Dashboard").Range("E3") & "\Desktop\" & SaveAs_Name
                        .Close
                    End If
                
            End With
                
            
                
Next cl
        
End With




With Application
   .ScreenUpdating = True
   .DisplayAlerts = True
   .EnableEvents = True
End With


'Determine how many seconds code took to run
  MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")

'Notify user in seconds
  MsgBox "This code ran successfully in " & MinutesElapsed & " minutes", vbInformation
    


End Sub

 

[Anthony47]

I guess that you need to add nr = 0 at the beginning of the loop, or just after your ReDim Nary(etc etc)