Do while loop - pull file names and check namedrange

Question

I really need help with this! The goal of my code is to loop through all files in a folder and have it return the names of files that contain a named range called "PullData". I have a loop macro that goes through the directory to pull file names and a function... but they are not working. Please help!

Sub CommandButton()

Application.ScreenUpdating = False

'Unhide Sheet11 (Formulas) Sheet11.Visible = xlSheetVisible

Sheets("Formulas").Select 'PART 1: Loop File

 'Turn off screen updating
   'Application.ScreenUpdating = False

 'File list
  Dim Directory As String
  Dim FileName As String
  Dim IndexSheet As Worksheet
  Dim row As Long
  UserDir = Sheets("Formulas").Range("C2").Value
  
  'Change the directory below as needed
  Directory = UserDir
  If Left(Directory, 1) <> "\" Then
      Directory = Directory & "\"
  End If
  
  row = 11
  
  Set IndexSheet = ThisWorkbook.ActiveSheet
      
  FileName = Dir(Directory & "*.xls")

  Do While Name("PullData") And FileName <> ""
      IndexSheet.Cells(row, 2).Value = FileName
      row = row + 1
      FileName = Dir
  Loop
  
  Set IndexSheet = Nothing

'Go to MoveItems

   MoveReplaceRenew
   

'Hide Sheet11

   Sheet11.Visible = xlSheetVeryHidden
  'Turn on screen updating
   Application.ScreenUpdating = True
   

End Sub

'------------------------CHECK FUNCTION----------Function Name(NamedRange As String, _ Optional WB As Workbook) As Boolean

Dim N As Long On Error Resume Next N = Len(IIf(WB Is Nothing, ThisWorkbook, WB).Names(PullData).Name) NameExists = (Err.Number = 0)

End Function

Answer

Anna,

You really need to open a workbook to check if it has a defined name "PullData". I would expect the below to do what you describe, but there are aspects of the code I can only guess at. You don't need that function. (Function Name)

Sub CommandButton()

Application.ScreenUpdating = False

'Unhide Sheet11 (Formulas) Sheet11.Visible = xlSheetVisible

Sheets("Formulas").Select 'PART 1: Loop File

'Turn off screen updating
  'Application.ScreenUpdating = False

'File list
 Dim Directory As String
 Dim FileName As String
 Dim IndexSheet As Worksheet
 Dim rw As Long
 Dim userDir As String
 Dim bk As Workbook, nme As Name
 userDir = Sheets("Formulas").Range("C2").Value

 ' entry in C2 must be of the form    C:\Myfolder\Mysubfolder or C:\Myfolder\Mysubfolder\
 
 'Change the directory below as needed
 Directory = userDir

 ' ==> changed Left to Right

 If Right(Directory, 1) <> "\" Then
     Directory = Directory & "\"
 End If
 
 rw = 11
 
 Set IndexSheet = ThisWorkbook.ActiveSheet
 ' if you are writing to sheet Formulas then just do
 '  Set IndexSheet = WorkSheets("Formulas") - I don't
 '  know - but be as specific as possible if you don't
 '  have to be general
     
 FileName = Dir(Directory & "*.xls")

 Do While FileName <> ""
     Set bk = Workbooks.Open(Directory & FileName)
     Set nme = Nothing
     On Error Resume Next
       Set nme = bk.Names("PullData")
     On Error GoTo 0
     bk.Close Savechanges:=False
     If Not nme Is Nothing Then
       IndexSheet.Cells(rw, 2).Value = FileName
       rw = rw + 1
     End If
     FileName = Dir
 Loop
 
 Set IndexSheet = Nothing

'Go to MoveItems

  MoveReplaceRenew
  

'Hide Sheet11

  Sheet11.Visible = xlSheetVeryHidden
 'Turn on screen updating
  Application.ScreenUpdating = True
  

End Sub