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
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
Advertisement