Search for specific sheet in closed W/B
Thanks Thanks:  0
Likes Likes:  0
Results 1 to 2 of 2

Thread: Search for specific sheet in closed W/B

  1. #1
    New Member
    Join Date
    Feb 2002
    Location
    Washington State
    Posts
    33
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

     
    Seems like the code for this was posted a while ago, but it's Friday and I seem to not be able to locate it.

    What I am trying to do is to use an input box to have the user enter a sheet name and then have Excel search the workbooks in a certain directory for that sheet, then open the sheet.

    Any help would be appreciated.

    Rick

  2. #2
    MrExcel MVP Joe Was's Avatar
    Join Date
    Feb 2002
    Location
    Central Florida, USA
    Posts
    7,539
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default

      
    This set of Sub's builds a utility that searches for files in the current directory, current plus all the subs or your choice with a default directory option. It tells you the number of files found and then populates a sheet with the drive, path and file name. The last sub deletes the displayed log on the sheet. My application uses form buttons to the right of the screen to activate each sub. This should get you started you will need to add the code to also display the sheet names or filter for the wanted sheet. JSW
    Sub FilesInDirectory()
    Dim lngCellCounter As Long
    'Search current directory for all files.

    Application.ScreenUpdating = False
    With Application.FileSearch
    .NewSearch
    .FileType = msoFileTypeExcelWorkbooks
    .LookIn = CurDir()
    .SearchSubFolders = False
    If .Execute() > 0 Then

    MsgBox "There were " & .FoundFiles.Count & " file(s) found."

    For lngCellCounter = 1 To .FoundFiles.Count
    Cells(lngCellCounter, 1) = .FoundFiles(lngCellCounter)
    Sheets("Sheet1").Select
    Next lngCellCounter

    Range("A1").Select
    Selection.EntireRow.Insert
    Range("AA2").Select
    Selection.Copy
    Range("A1").Select
    ActiveSheet.Paste
    Else

    MsgBox "No Excel WorkBooks found!"
    End If

    End With
    Application.ScreenUpdating = True
    End Sub


    Sub GetAllFiles()
    Dim lngCellCounter As Long
    'Search all subdirectories of the current directory.

    Application.ScreenUpdating = False
    With Application.FileSearch
    .NewSearch
    .FileType = msoFileTypeExcelWorkbooks
    .LookIn = CurDir()
    .SearchSubFolders = True
    If .Execute() > 0 Then

    MsgBox "There were " & .FoundFiles.Count & " file(s) found."

    For lngCellCounter = 1 To .FoundFiles.Count
    Cells(lngCellCounter, 1) = .FoundFiles(lngCellCounter)
    Sheets("Sheet1").Select
    Next lngCellCounter

    Range("A1").Select
    Selection.EntireRow.Insert
    Range("AA2").Select
    Selection.Copy
    Range("A1").Select
    ActiveSheet.Paste
    Else

    MsgBox "No Excel WorkBooks found!"

    End If
    End With
    Application.ScreenUpdating = True
    End Sub

    Sub Look_In_x()
    Dim lngCellCounter As Long
    Dim Message, Title, Default, MyDir
    'Search current directory for all files.

    Application.ScreenUpdating = False
    Message = "Enter the directory to search?" & Chr(13) & Chr(13) & "(Drive:DirectorySubDirectory)" ' Set prompt.
    Title = "Enter: Drive and Path!" ' Set title.
    Default = "H:UsersRW155JW" ' Set default.
    ' Display message, title, and default value.
    On Error GoTo myErr

    MyDir = InputBox(Message, Title, Default)

    With Application.FileSearch
    .NewSearch
    .FileType = msoFileTypeExcelWorkbooks
    .LookIn = MyDir
    .SearchSubFolders = True
    If .Execute() > 0 Then

    MsgBox "There were " & .FoundFiles.Count & " file(s) found."

    For lngCellCounter = 1 To .FoundFiles.Count
    Cells(lngCellCounter, 1) = .FoundFiles(lngCellCounter)
    Sheets("Sheet1").Select
    Next lngCellCounter

    Range("A1").Select
    Selection.EntireRow.Insert
    Range("AA2").Select
    Selection.Copy
    Range("A1").Select
    ActiveSheet.Paste
    Else

    MsgBox "No Excel WorkBooks found!"
    End If

    End With
    Application.ScreenUpdating = True
    End
    myErr:

    MsgBox "No Excel WorkBooks found!"

    End Sub
    Sub Delete_Data()
    'Delete the current screen print of file data.

    Application.ScreenUpdating = False
    Columns("A:A").Select
    Selection.ClearContents
    Range("A1").Select
    Selection.EntireRow.Delete
    Range("C1").Select
    Application.ScreenUpdating = True
    End Sub


User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

 

 
DMCA.com