Bypass if array is empty

[Harshil Mehta]

The code gives an error before pasting if the array is empty. What could be the best solution to bypass if there is not data store in the array?

Nary is out of subscription.

'

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

                
'Paste data from the array to Destination Sheet
            With OpenDestination
                        
                 With .Sheets(DestinationSheet)
                   
                   '.Range("A2").Resize(nr, UBound(Nary, 2))
                         With .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(nr, UBound(Nary, 2))
                             .NumberFormat = "@"    'Text format
                             .Value = Nary
                             .NumberFormat = "General"
                         End With

 

[RoryA]

I'd guess the error is due to nr being 0, not the array size - but it would have helped if you'd posted the code before this part. Test for that.

 

[Legacy 143009]

The code below sums the numbers in 2nd dimension of Nary. If you have numbers in the first dimension switch 2 to 1.

  If Application.Sum(Application.Index(Nary, 0, 2)) > 0 Then
    With .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(nr, UBound(Nary, 2))
      .NumberFormat = "@"    'Text format
      .Value = Nary
      .NumberFormat = "General"
    End With
  End If

 

[shinigamilight]

It doesn't look like you posted the whole code.

 

[Harshil Mehta]

I'd guess the error is due to nr being 0, not the array size - but it would have helped if you'd posted the code before this part. Test for that.

If I change nr=1, then it does not give me an error if the array is empty. However, a blank row is been added on top of the data set while pasting where the array is not empty.

Sub CountryCuts()


Dim SourceFilePath As String, CountryKey As String, SourceSheet As String, SourceCol As String, SearchType As String, CountryName As String, DestinationFilePath As String, DestinationSheet 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
Dim tb1 As ListObject




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 i = 12 To lastRow
            
        
'Declare value for placeholder
            CountryKey = ThisWorkbook.Sheets("Dashboard").Cells(i, 5).Value
            SourceSheet = ThisWorkbook.Sheets("Dashboard").Cells(i, 6).Value
            SourceCol = ThisWorkbook.Sheets("Dashboard").Cells(i, 7).Value ' Column Number
            DestinationFilePath = ThisWorkbook.Sheets("Dashboard").Cells(i, 8).Value
            DestinationSheet = ThisWorkbook.Sheets("Dashboard").Cells(i, 9).Value
            SearchType = ThisWorkbook.Sheets("Dashboard").Cells(i, 11).Value
            SaveAs_Name = ThisWorkbook.Sheets("Dashboard").Cells(i, 10).Value
            SaveAs_Path = ThisWorkbook.Sheets("Dashboard").Range("H3").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
        
        nr = 1
'Find and add matched cases into another array
            ReDim Nary(1 To UBound(Ary), 1 To c)
            For r = 1 To UBound(Ary)
                If SearchType = "Exact Match" Then
                        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
                Else
                        If InStr(1, Trim(LCase(Ary(r, SourceCol))), CountryKey, vbTextCompare) > 0 Then
                            nr = nr + 1
                                For c = 1 To UBound(Ary, 2)
                                    Nary(nr, c) = Ary(r, c)
                                Next c
                        End If
                End If
            Next r

                
'Paste data from the array to Destination Sheet
            With OpenDestination
                        
                 With .Sheets(DestinationSheet)
                   If Application.Sum(Application.Index(Nary, 0, 2)) > 0 Then
                   '.Range("A2").Resize(nr, UBound(Nary, 2))
                         With .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(nr, UBound(Nary, 2))
                             .NumberFormat = "@"    'Text format
                             .Value = Nary
                             .NumberFormat = "General"
                         End With
                    End If
 'Rezize table
                        'Set tb1 = .ListObjects("My_Table")
                        '.Range("A2").PasteSpecial Paste:=xlPasteValues
                        'tb1.Resize tb1.Range.CurrentRegion
                        
                        
                 End With
                 
                        .RefreshAll
            
            
                    If SaveAs_Name = "" Then
                    
                    Else
                        '.Name = NewSheetName
                        .SaveAs SaveAs_Path & SaveAs_Name
                        
                        Workbooks(SaveAs_Name).Close
                    End If
                    
            End With
                
                
Next i
        
End With


Workbooks(Dir(SourceFilePath)).Close

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



ThisWorkbook.Sheets("Dashboard").Activate
Successful_Msg

'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

 

[Alex Blakenburg]

Are you sure we are not overcomplicating this ?
Following on from @RoryA's comment in Post#2, why not go back to your original code (which has nr starting at 0 and no Application.Sum) and just test for nr is 0.

            With OpenDestination
                        
                 With .Sheets(DestinationSheet)
                   If nr > 0 Then
                   '.Range("A2").Resize(nr, UBound(Nary, 2))
                         With .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(nr, UBound(Nary, 2))
                             .NumberFormat = "@"    'Text format
                             .Value = Nary
                             .NumberFormat = "General"
                         End With
                    End If

You may also want to close without the Refresh and without Saving, since you didn't write to that Destination workbook.