IFERROR or ONERROR in dynamic data import

[Pelle Peloton]

Hi!

I have one master Excel (sheet "WP_Data") to which I import data (content from two separate cells and the Excel name) from tens of source-Excels. In each of these source-Excels I have sheet named "Workpaper_main", where I have a cell that is named as "WP_balance". I have the folder path on sheet "parameters" in cell "E24".

The issue is that I also want to bring a cell value from a named cell "WP_balance2", but that cell name does not exists in all the source-Excels. The below code works, when my path folder includes only Excels that have both "WP_balance" and "WP_balance2" named cells in all the source-Excels. I tried to use IFERROR and ON ERROR different ways (and also "IF"..."THEN") to achieve that the if "WP_balance2" does not exist --> None of the commands at the bottom half of the code would be executed. How could I solve this?

Sub import_data()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = thisWorkbook
    Dim LastRow As Long
   
    'empty old data on "WP_Data" sheet
    wkbDest.Sheets("WP_Data").Activate
    Columns("A:B").Select
    Selection.ClearContents
    Range("A1").Select
  
    'Search "WP_Balance" from the separate Excels
    Dim strPath As String
    strPath = wkbDest.Sheets("Parameters").Range("E24").Value
        ChDir strPath
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
        .Sheets("Workpaper_main").Range("WP_balance").Copy
      
    'copy the figures from separate Excels and paste to this Master-Excel
        wkbDest.Sheets("WP_Data").Cells(wkbDest.Sheets("WP_Data").Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
      
     'copy the Excel names and paste to this Master-Excel
       wkbDest.Sheets("WP_Data").Activate
       fRow = wkbDest.Sheets("WP_Data").Range("B" & Cells(Rows.Count, "B").End(xlUp).Row).Offset(0, 0).Row
       lrow = wkbDest.Sheets("WP_Data").Range("B" & Cells(Rows.Count, "B").End(xlUp).Row).Row
       wkbDest.Sheets("WP_Data").Range("A" & fRow) = wkbSource.Name
   
        .Close savechanges:=False
                    
        End With
strExtension = Dir
    Loop


'Search "WP_Balance2" from the separate Excels
'If there is no "WP_Balance2" named cell in the Excel, I want that the code would do none of the commands below
Dim str2Path As String
    str2Path = wkbDest.Sheets("Parameters").Range("E24").Value
    ChDir str2Path
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
.Sheets("Workpaper_main").Range("WP_balance2").Copy

    'copy the figures from separate Excels and paste to this Master-Excel
        wkbDest.Sheets("WP_Data").Cells(wkbDest.Sheets("WP_Data").Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
      
     'copy the Excel names and paste to this Master-Excel
       wkbDest.Sheets("WP_Data").Activate
       fRow = wkbDest.Sheets("WP_Data").Range("B" & Cells(Rows.Count, "B").End(xlUp).Row).Offset(0, 0).Row
       lrow = wkbDest.Sheets("WP_Data").Range("B" & Cells(Rows.Count, "B").End(xlUp).Row).Row
       wkbDest.Sheets("WP_Data").Range("A" & fRow) = wkbSource.Name & "2"
    
Close savechanges:=False
           
        End With
        strExtension = Dir
    Loop

    Application.ScreenUpdating = True

End Sub

 

[DanteAmor]

How about:

Sub import_data()
  Dim strExtension As Variant, nmd As Variant
  Dim wkbDest As Workbook, wkbSource As Workbook
  Dim shDest As Worksheet
  Dim strPath As String
  Dim rng As Range
  
  Application.ScreenUpdating = False
  Set wkbDest = ThisWorkbook
  Set shDest = wkbDest.Sheets("WP_Data")
  
  shDest.Range("A:B").ClearContents   'empty old data on "WP_Data" sheet
  strPath = wkbDest.Sheets("Parameters").Range("E24").Value
  If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
  strExtension = Dir(strPath & "*.xls*")
  Do While strExtension <> ""
    Set wkbSource = Workbooks.Open(strPath & strExtension)
    For Each nmd In Array("WP_balance", "WP_balance2")
      Set rng = Nothing
      On Error Resume Next
        Set rng = wkbSource.Sheets("Workpaper_main").Range(nmd)
      On Error GoTo 0
      If Not rng Is Nothing Then
        shDest.Range("A" & Rows.Count).End(3)(2).Resize(, 2).Value = Array(wkbSource.Name, rng.Value)
      End If
    Next
    wkbSource.Close False
    strExtension = Dir
  Loop
End Sub