Search for a file in folder and subfolders – UDF

1. Search for a file in folder and subfolders - UDF

The image above demonstrates a user-defined function in cell range B6:D7 that allows you to search a folder and subfolders for a file name. It returns the exact path to the file, file name, and the file size.

A user defined function is a custom function that you can build yourself if none of Excel's built-in functions works for you.

Array formula in cell range B6:D7:

To enter an array formula, select cell range B6:D7. Type the formula and then press and hold CTRL + SHIFT simultaneously, now press Enter once. Release all keys.

The formula bar now shows the formula with a beginning and ending curly bracket telling you that you entered the formula successfully. Don't enter the curly brackets yourself.

1.1 User Defined Function Syntax

ListFiles(filename, path)

1.2 Arguments

filename	Required. The filename you are looking for.
path	Required. The full path to the folder you want the UDF to begin searching in. The function will also search in all subfolders of this folder.

1.3 VBA Macro

There are actually two user-defined functions in order to search all subfolders and a variable that needs to be located at the very top of your workbook's code module.

Public temp() As String

Here is the first UDF, it makes sure that the result doesn't contain any error values.

Function ListFiles(FileName As String, FolderPath As String)
Dim k As Long, i As Long
ReDim temp(2, 0)
If Right(FolderPath, 1) <> "\" Then
    FolderPath = FolderPath & "\"
End If
Recursive FileName, FolderPath
k = Range(Application.Caller.Address).Rows.Count

If k < UBound(temp, 2) Then
Else
    For i = UBound(temp, 2) To k
          ReDim Preserve temp(UBound(temp, 1), i)
            temp(0, i) = ""
            temp(1, i) = ""
            temp(2, i) = ""
    Next i
End If
ListFiles = Application.Transpose(temp)
ReDim temp(0)
End Function

The second UDF is recursive meaning that a new instance of this UDF is created for each subfolder.

Function Recursive(FileName As String, FolderPath As String)
Dim Value As String, Folders() As String
Dim Folder As Variant, a As Long
ReDim Folders(0)
If Right(FolderPath, 2) = "\\" Then Exit Function
Value = Dir(FolderPath, &H1F)
Do Until Value = ""
    If Value = "." Or Value = ".." Then
    Else
        If GetAttr(FolderPath & Value) = 16 Then
            Folders(UBound(Folders)) = Value
            ReDim Preserve Folders(UBound(Folders) + 1)
        Else
            If Value = FileName Then
                temp(0, UBound(temp, 2)) = FolderPath
                temp(1, UBound(temp, 2)) = Value
                temp(2, UBound(temp, 2)) = FileLen(FolderPath & Value)
                ReDim Preserve temp(UBound(temp, 1), UBound(temp, 2) + 1)
            End If
        End If
    End If
    Value = Dir
Loop
For Each Folder In Folders
    Recursive FileName, FolderPath & Folder & "\"
Next Folder
End Function

1.4 Where to put the code?

Follow these steps to insert the code into your workbook.

1. Copy macro.
2. Go to VB Editor (Alt+F11).
   
3. Press with mouse on "Insert" on the top menu.
4. Press with left mouse button on "Module" to insert a module into the workbook.
5. Paste macro to the code module.
6. Exit VB Editor.
7. Save the workbook as a macro-enabled workbook (*.xlsm).
   If you don't the macro will be gone the next time you open the workbook.

2. Search for a file in folder and subfolders using the FSO object

The following User defined Function, shown in the image above, allows you to search through folders and subfolders for a specified file name.

The first UDF above utilizes the DIR function that sometimes returns error 52 which translates to "Bad file name or number", the FSO object seems to handles this better.

VBA code

Public temp() As String

Function ListFiles(FileName As String, FolderPath As String)
Dim k As Long, i As Long
ReDim temp(2, 0)
If Right(FolderPath, 1) <> "\" Then
    FolderPath = FolderPath & "\"
End If
Recursive FileName, FolderPath
k = Range(Application.Caller.Address).Rows.Count

If k < UBound(temp, 2) Then
Else
    For i = UBound(temp, 2) To k
          ReDim Preserve temp(UBound(temp, 1), i)
            temp(0, i) = ""
            temp(1, i) = ""
            temp(2, i) = ""
    Next i
End If
ListFiles = Application.Transpose(temp)
ReDim temp(0)
End Function

Function Recursive(FileName As String, FolderPath As String)
Dim objFSO As Object
Dim Value As String, Folders() As String
Dim Folder As Variant, a As Long
ReDim Folders(0)

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(FolderPath)

If Right(FolderPath, 2) = "\\" Then Exit Function

    For Each objFile In objFolder.Files
        If objFile.Name = FileName Then
        
            temp(0, UBound(temp, 2)) = FolderPath
            temp(1, UBound(temp, 2)) = objFile.Name
            temp(2, UBound(temp, 2)) = objFile.Size
            ReDim Preserve temp(UBound(temp, 1), UBound(temp, 2) + 1)
            
        End If
    
    Next objFile
    
    For Each objFolder In objFolder.Subfolders
    
            Folders(UBound(Folders)) = objFolder.Name
            ReDim Preserve Folders(UBound(Folders) + 1)
    
    Next objFolder
    
For Each Folder In Folders

    On Error Resume Next
    Recursive FileName, FolderPath & Folder & "\"
    On Error GoTo 0
    
Next Folder

End Function

3. List files in a folder and sub folders - UDF

This section of the article demonstrates a user defined function that lists files in a given folder and sub folders. A user defined function is a custom function in Excel that anyone can build, simply copy the VBA code and paste to your workbook's code module and you are good to go.

Array formula in cell range B3:D9:

To enter an array formula, select the cell range, type the formula, then press and hold CTRL + SHIFT simultaneously, now press Enter once. Release all keys.

The formula bar now shows the formula with a beginning and ending curly bracket telling you that you entered the formula successfully. Don't enter the curly brackets yourself.

3.1 User defined Function Syntax

ListFiles(FolderPath)

3.2 Arguments

Parameter	Text
FolderPath	Required. The path to the folder you want to use.

3.3 Where to copy vba code?

1. Press Alt-F11 to open visual basic editor
2. Press with left mouse button on Module on the Insert menu
3. Copy and paste vba code, both functions below.
4. Exit visual basic editor

'Declare a public variable meaning it will exist for both functions below.
Public temp() As String

'Name function and declare parameters
Function ListFiles(FolderPath As String)
'Declare arguments and data types
Dim k As Long, i As Long
'Redimension array variable temp so it can contain more values if needed.
ReDim temp(2, 0)
'Add and ending backslash to pathe if missing
If Right(FolderPath, 1) <> "\" Then
    FolderPath = FolderPath & "\"
End If
'Start second function named Recursive with folder path
Recursive FolderPath
'Count cells the UDF is using
k = Range(Application.Caller.Address).Rows.Count
'Return a message if cell range needs to be larger in order to show all values
'or fill array values with blanks to avoid error values when no more values is to be shown
If k < UBound(temp, 2) Then
    MsgBox "There are more rows, extend user defined function"
Else
    For i = UBound(temp, 2) To k
          ReDim Preserve temp(UBound(temp, 1), i)
            temp(0, i) = ""
            temp(1, i) = ""
            temp(2, i) = ""
    Next i
End If
'Return values
ListFiles = Application.Transpose(temp)
ReDim temp(0)
End Function

'Name function and declare parameter
Function Recursive(FolderPath As String)
'Declare variables and data types
Dim Value As String, Folders() As String
Dim Folder As Variant, a As Long
'Redimension array variable Folders so it can contain more folder paths if needed.
ReDim Folders(0)
'If folder path ends with \\ then end function
If Right(FolderPath, 2) = "\\" Then Exit Function
'Open folder path and populate Value with file names/folders
Value = Dir(FolderPath, &H1F)
'Repeat code until all file names have been retrieved
Do Until Value = ""
    'Ignore file name . and ..
    If Value = "." Or Value = ".." Then
    Else 
        'If value is a folder then save value to variable Folders
        If GetAttr(FolderPath & Value) = 16 Then
            Folders(UBound(Folders)) = Value
            ReDim Preserve Folders(UBound(Folders) + 1)
        Else
            'If value is a file name then save path, name and size to variable temp
            temp(0, UBound(temp, 2)) = FolderPath
            temp(1, UBound(temp, 2)) = Value
            temp(2, UBound(temp, 2)) = FileLen(FolderPath & Value)
            ReDim Preserve temp(UBound(temp, 1), UBound(temp, 2) + 1)
        End If
    End If
    'Continue with next value in folder
    Value = Dir
Loop
'Start a new instance of function Recursive for each new folder
For Each Folder In Folders
    Recursive FolderPath & Folder & "\"
Next Folder
End Function

4. Unzip files in folder and sub folders

The VBA macro demonstrated in this article lets you unzip all zip files in a folder to a destination folder you specify. It continues with subfolders until all zip files have been unzipped.

4.1. VBA Code

Actually, there are two macros. Run macro named UnzipFiles to start unzipping files.

'Name macro
Sub UnzipFiles()

'Dimension variables and declare data types
Dim myfolder As Variant
Dim destfolder As Variant

'Ask for a source folder
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show

    'Save selected folder path to variable myfolder
    myfolder = .SelectedItems(1) & "\"
End With

'Ask for a destination folder
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    destfolder = .SelectedItems(1) & "\"
End With

'Run macro named Recursive with parameters myfolder and destfolder
Call Recursive(myfolder, destfolder)

End Sub

'Name macro and dimension parameters
Sub Recursive(FolderPath As Variant, destfolder As Variant)

'Dimension variables and declare data types
Dim Value As String, Folders() As String
Dim Folder As Variant, a As Long
Dim SApp As Object

'Redimension variable Folders
ReDim Folders(0)

'If...Then statement
'Check if last two characters are // and stop macro if true
If Right(FolderPath, 2) = "\\" Then Exit Sub

'Dir function returns a String representing the name of a file, directory, or folder, save string to variable Value
Value = Dir(FolderPath, &H1F)

'Do Until ... Loop statement
Keep iterating lines between Do Until and Loop
Do Until Value = ""

    'If ... Then ... Else ... Endif statement
    'Check if variable Value is equal to . or ..
    If Value = "." Or Value = ".." Then
    'Continue here if variable Value is not equal to . or ..
    Else
         
        'If ... Then ... Else ... Endif statement
        'Check if attribute for file is equal to 16 or 48 indicating it is a folder
        If GetAttr(FolderPath & Value) = 16 Or GetAttr(FolderPath & Value) = 48 Then

            'Save Folder name to variable Folders
            Folders(UBound(Folders)) = Value

            'Add another container to variable Folders, in other words, increase size of array variable Folders by 1
            ReDim Preserve Folders(UBound(Folders) + 1)

        'Continue here if attribute for file is equal to 16 or 48 indicating it is a folder
        Else

            'Check if last four characters in filename equals .zip
            If Right(Value, 4) = ".zip" Then

                'Unzip file to destination folder
                Set SApp = CreateObject("Shell.Application")
                SApp.Namespace(destfolder).CopyHere _
                SApp.Namespace(FolderPath & Value).items
            End If
        End If
    End If
    Value = Dir
Loop

'Start macro Recursive for each folder in variable Folders
For Each Folder In Folders
    Call Recursive(FolderPath & Folder & "\", destfolder)
Next Folder

End Sub

4.2. Where to put the code?

1. Press Alt + F11 to open the Visual Basic Editor (VBE).
2. Press with left mouse button on "Insert" on the top menu.
3. Press with left mouse button on "Module" to create a new module.
4. Paste VBA code to code window.
5. Exit VBE and return to Excel.

4.3. How to run the macro?

1. Press Alt + F8 to open the Macro" dialog box.
2. Press with left mouse button on the macro name to select it.
3. Press with left mouse button on "Run" button.

4.4. What happens when you run the macro?

1. Select a folder you want to search.
2. Select a destination folder. This is where all unzipped files will be copied to.
3. Macro unzips all zip files in folder and subfolders.
4. Macro ends.

5. Find and replace strings in file names, folder name and subfolders

The following two macros FindReplace() and Recursive() let you rename files and folders recursively based on a search string. The file or folder is renamed if the name contains the search string.

The search string in the file name is replaced by another string you specify. A dialog box appears asking if you want to rename the found file name that matches the search string.

5.1. VBA macros

'Webpage: https://www.get-digital-help.com/find-and-replace-a-text-string-in-file-names-folder-name-and-subfolders/
'Name macro
Sub FindReplace()

'Dimension variables and declare data types
Dim myfolder As Variant
Dim Fnd As String, Rplc As String

'Display input box and ask for a string to search for
Fnd = Application.InputBox(prompt:="Find string:", Title:="Rename files and folders", Type:=2)

'Display another input box and ask for a string to replace with
Rplc = Application.InputBox(prompt:="Replace with:", Title:="Rename files and folders", Type:=2)

'Ask for a folder to search
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
myfolder = .SelectedItems(1) & "\"
End With

'Start macro Recursive with parameters myfolder, Fnd, and Rplc
Call Recursive(myfolder, Fnd, Rplc)
End Sub

'Name macro and parameters
Sub Recursive(FolderPath As Variant, Fnd As String, Rplc As String)

'Dimension variables and declare data types
Dim Value As String, Folders() As String, Fname As String, Fext As String, Mtxt As String
Dim x As Integer
Dim Folder As Variant, a As Long

'Redimension array variable Folders 
ReDim Folders(0)

'If ... Then statement
'Check if two last characters equals \\
If Right(FolderPath, 2) = "\\" Then Exit Sub

'Dir function returns a String representing the name of a file, directory, or folder that matches a specified pattern
Value = Dir(FolderPath, &H1F)

'Do Until ... Loop statement
Do Until Value = ""

'Check if Value is equal to . or ..
If Value = "." Or Value = ".." Then

'Continue here if Value is not equal to . or ..
Else

'Check if Value is a folder
If GetAttr(FolderPath & Value) = 16 Or GetAttr(FolderPath & Value) = 48 Then

'Enable error handling
On Error Resume Next

'Concatenate text with value in variable Value and show the new file name
Mtxt = "Rename folder " &  Value & " to " & WorksheetFunction.Substitute(Value, Fnd, Rplc) & "?"

'Show message box containing buttons Yes, No, and Cancel
x = MsgBox(Mtxt, vbYesNoCancel)

'End macro If user press with left mouse button ons Cancel button
If x = vbCancel Then Exit Sub

'Check if user press with left mouse button ons Yes
If x = vbYes Then

'Rename file if user press with left mouse button ons yes
Name FolderPath & Value As FolderPath &  WorksheetFunction.Substitute(Value, Fnd, Rplc)
End If

'Substitute string specified in Fnd with string in Rplc and save to variable Value
Value = WorksheetFunction.Substitute(Value, Fnd, Rplc)

'Check if an error has occurred
If Err <> 0 Then

'Show message box containing text "Error"
MsgBox "Error"

'Stop macro
Exit Sub
End If

'Disable error handling
On Error GoTo 0

Save string in variable Value to array variable Folders
Folders(UBound(Folders)) = Value

'Add another container to array variable Folders
ReDim Preserve Folders(UBound(Folders) + 1)

'Continue here if an error has not occurred
Else

'Enable error handling
On Error Resume Next

'Save extension text to variable Fext
Fext = Split(Value, ".")(UBound(Split(Value, ".")))

'Save file name without extension to variable Fname
Fname = Left(Value, Len(Value) - Len(Split(Value, ".")(UBound(Split(Value, ".")))) - 1)

'Replace search string (Fnd) with replace string (Rplc) in variable Fname and save to Fname
Fname = WorksheetFunction.Substitute(Fname, Fnd, Rplc)

'Check if value is not equal to Fname, dot and Ftext
If Value <> (Fname &  "." & Fext) Then

'Create text string and save to variable Mtxt
Mtxt = "Rename file " & Value & " to " & Fname & "." & Fext &  "?"

'Show message box containing text in variable Mtxt with buttons Yes, No, and Cancel. Save result to variable x
x = MsgBox(Mtxt, vbYesNoCancel)

'Check if variable x is equal to vbCancel meaning the user press with left mouse button oned Cancel button, stop macro if true
If x = vbCancel Then Exit Sub

'Check if user press with left mouse button on Yes
If x = vbYes Then

'Rename file
Name FolderPath &  Value As FolderPath & Fname &  "." & Fext
End If
End If

'Check if an error has occurred
If Err <> 0 Then

'Display message box containing text Error
MsgBox "Error"

'Stop macro
Exit Sub
End If

'Disable error handling
On Error GoTo 0
End If
End If

'Save a new item in current Folder to variable Value
Value = Dir

'Go back to Do Until, see above
Loop

'Iterate through all folders in array variable Folders
For Each Folder In Folders

'Start macro Recursive using folder name and path
Call Recursive(FolderPath &  Folder &  "\", Fnd, Rplc)
Next Folder
End Sub

Back to top

5.2. Where to put the code?

1. Press Alt + F11 to open the Visual Basic Editor (VBE), see image above.
2. Press with left mouse button on "Insert" on the top menu, a popup menu appears.
3. Press with left mouse button on "Module". A new module is created in your workbook.
4. Copy VBA code above and paste to code window, see image above.
5. Exit VBE and return to Excel.

Back to top

5.3. How to start the macro?

1. Press Alt + F8, a dialog box appears. See the image above.
2. Press with mouse on "FindReplace" to select it.
3. Press with left mouse button on "Run" button.

Back to top

5.4. What happens when you run macro?

1. Type a text string you want to find in the dialog box.
   
2. In the next dialog box, type a text sting you want to replace it with.
   
3. Select a folder, press with left mouse button on OK.
4. The macro prompts you each time it finds a file name or folder with the text string you are looking for and ask if you want to rename it.
5. Your options are: Yes, No, and Cancel. Cancel exits the macro.
6. The macro continues until all files and folders are processed.

The macro does NOT change the file extension name.

Back to top

Back to top

6. Open Excel files in a folder - VBA

This tutorial shows you how to list excel files in a specific folder and create adjacent checkboxes, using VBA. The last macro opens selected files.

The animated image below shows the user typing the folder name in cell B1, press with left mouse button on "Refresh list" button and cell range A4:B6 is populated with file names, file sizes and checkboxes.

The checkboxes allow the user to select workbook files to open, the selected workbooks are opened as soon as the user press with left mouse button ons on "Open selected files" button located on the worksheet.

What you will learn in this article

• How to insert buttons on the worksheet.
• How to assign macros to the buttons.
• How to use macros.
• How to list files and file sizes from a given folder on a worksheet using VBA.
• How to insert checkboxes programmatically.
• How to open selected files programmatically.
• How to save VBA code to your workbook.

6.1 List files in a folder

The following macro is assigned to the "Refresh list" button. It lists all *.xls, *.xlsx and *.xlsm files in the folder specified in cell B1.

'Name macro
Sub ListFiles()

'Dimension variables and declare data types
Dim cell As Range, selcell As Range
Dim Value As String
Dim Folder As Variant, a As Long
ReDim Folders(0)

'Save cell A4 to object cell
Set cell = Range("A4")

'Save selected cell (range) to variable selcell
Set selcell = Selection

'Clear cell range A4:B10000
Range("A4:B10000").Value = ""

'Save value in cell B1 to variable Folderpath
Folderpath = Range("B1").Value

'Check if variable Folderpath ends with \ (backslash)
If Right(Folderpath, 1) <> "\" Then

  'Add a backslash if missing
  Folderpath = Folderpath & "\"
End If

'Return first file name in path specified in variable Folderpath
Value = Dir(Folderpath, &H1F)

'Continue iterate through files in folder until it is empty
Do Until Value = ""

    'Make sure file name is not . (current directory) or .. (parent directory)
    If Value <> "." And Value <> ".." Then

        'Make sure file name is not a folder
        If GetAttr(Folderpath & Value) <> 16 Then

            'Make sure file name ends with .xls or .xlsx or .xlsm
            If Right(Value, 4) = ".xls" Or Right(Value, 5) = ".xlsx" Or Right(Value, 5) = ".xlsm" Then
                
                'Save file name and file size to cell A4 and cell B4 respectively
                cell.Offset(0, 0).Value = Value
                cell.Offset(0, 1).Value = FileLen(Folderpath & Value)

                'Move to cell below 
                Set cell = cell.Offset(1, 0)
            End If
        End If
    End If
'Continue with next file
Value = Dir

'Go back to Do Until
Loop

'Start macro Addcheckboxes
Call Addcheckboxes

'Select the same cells that were selected when the macro started
selcell.Select

End Sub

Recommended reading

Recommended articles

6.2 Add checkboxes to column C

'Name macro
Sub Addcheckboxes()

'Dimension variables and declare data types
Dim cell, LRow As Single
Dim chkbx As CheckBox
Dim CLeft As Double, CTop As Double, CHeight As Double, CWidth As Double

'Stop Excel screen from updating, this makes the macro a lot faster
Application.ScreenUpdating = False

'Delete all old checkboxes on active worksheet
ActiveSheet.CheckBoxes.Delete

'Save row number of cell containing non-empty values to variable LRow
LRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

'Iterate through number 4 to number stored in variable LRow
For cell = 4 To LRow

    'Make sure cell is not empty
    If Cells(cell, "A").Value <> "" Then

        'Save the number of pixels between cell in column C based on the row number stored in variable cell and left edge
        CLeft = Cells(cell, "C").Left

        'Save the number of pixels between cell in column C based on the row number stored in variable cell and top
        CTop = Cells(cell, "C").Top

        'Save the height (number of pixels) of cell in column C based on the row number stored in variable cell
        CHeight = Cells(cell, "C").Height
        
        'Save the cell width (in pixels) of cell in column C based on the row number stored in variable cell
        CWidth = Cells(cell, "C").Width

        'Insert and select checkbox based on left, top, width and height
        ActiveSheet.CheckBoxes.Add(CLeft, CTop, CWidth, CHeight).Select

        'Remove text and make sure checkbox is not checked
        With Selection
            .Caption = ""
            .Value = xlOff
            .Display3DShading = False
        End With
    End If
Next cell

'Show Excel screen changes
Application.ScreenUpdating = True
End Sub

Recommended reading

Recommended articles

6.3 Open selected files

The macro below is assigned to "Open selected files" button. It checks if a checkbox is enabled and opens the excel file.

'Name macro
Sub OpenFiles()

'Dimension variables and declare data types
Dim Folderpath As String
Dim cell As Range
Dim r As Single, LRow As Single
Dim CWB As Workbook

'Save value in cell B1 to variable Folderpath 
Folderpath = Range("B1").Value

'Save Active Workbook to object CWB
Set CWB = ActiveWorkbook

'Check if last character in folder path is not a backslash
If Right(Folderpath, 1) <> "\" Then

  'Add backslash
  Folderpath = Folderpath & "\"
End If

'Iterate through checkboxes located on active worksheet
For Each chkbx In ActiveSheet.CheckBoxes

    'Check if checkbox is enabled
    If chkbx.Value = 1 Then

        'Count cells above checkbox in order to open the right file
        For r = 1 To Rows.Count

            'Check if pixel count is the same between cell and checkbox
            If Cells(r, 1).Top = chkbx.Top Then

                'Open workbook based on name in cell
                Workbooks.Open Filename:=Folderpath & Range("A" & r).Value

                'Stop macro
                Exit For
            End If

        'Continue with next row number
        Next r

        'Activate workbook
        CWB.Activate
    End If
Next

End Sub

6.4 Where to put the macros?

1. Press Alt + F11 to open the Visual Basic Editor.
2. Press with left mouse button on "Insert" on the top menu.
3. Press with left mouse button on "Module" to insert a code module. It will appear in the project explorer, see image above.
4. Copy above VBA code and paste to the code module.
5. Exit VB Editor and return to Excel.

7. List files in folder and create hyperlinks - VBA

Table of Contents

1. List files in a folder and create hyperlinks (VBA)
2. How to navigate quickly in a complex workbook using hyperlinks

7.1. List files in a folder and create hyperlinks (VBA)

This section demonstrates a macro that populates a new worksheet with filenames from the active folder which is the same folder as the workbook was saved in. The filenames are hyperlinks that make it easy for you to quickly open any file.

What you will learn in this article

• How to not show changes made from macro, until it is finished processing, in order to speed up the macro.
• Save a worksheet object to a variable.
• Create a new worksheet and save it to an object.
• Iterate through files in a given folder programmatically.
• Ignore the current folder and parent folder.
• Write hyperlinks to a worksheet programmatically.
• Move from one cell to another using VBA.
• Identify folders using DIR function.

How the macro works

The animated picture below shows how the macro works.

1. Press Alt + F8 to open the macro dialog box.
2. Press with mouse on InsertFilesInFolder to select it.
3. Press with left mouse button on "Run" button to run the selected macro.
4. A new worksheet is automatically inserted to your workbook.
5. The macro populates column A with file names from the same directory that the workbook was saved in.
6. The filenames are hyperlinks that you can press with left mouse button on to open.

VBA Code

'Name macro
Sub InsertFilesInFolder()

'Don't show changes on worksheet to user, this will speed up the macro a lot
Application.ScreenUpdating = False
'Dimension variables and declare data types
Dim sPath As String, Value As String
Dim WS As Worksheet

'Add a new worksheet and save it to variable WS
Set WS = Sheets.Add

'Save workbook path to variable sPath and append \
sPath = ActiveWorkbook.Path & "\"

'Get filename from files in folder sPath
Value = Dir(sPath, &H1F)

'Save text Filename to cell A1
WS.Range("A1") = "Filename"

'Save cell A2 to variable StartCell
Set StartCell = WS.Range("A2")

'Loop through filenames until value is equal to nothing
Do Until Value = ""

'Ignore . (represents the folder you are in) and .. which is the parent folder
If Value = "." Or Value = ".." Then

'Continue with the following lines if value is not equal to . or ..
Else

    'Check if value is a folder name
    If GetAttr(sPath & Value) = 16 Then

    'Continue with values that are not folder names or . or ..
    Else

        'Check if value is equal to your workbook name or a temporary file that is created when the workbook is opened
        If Value <> ActiveWorkbook.Name And Value <> "~$" & ActiveWorkbook.Name Then

            'Create hyperlink
            StartCell.Hyperlinks.Add Anchor:=StartCell, Address:= _
            Value, TextToDisplay:=Value

            'Move to cell below
            Set StartCell = StartCell.Offset(1, 0)
        End If
    End If
  End If

'Move to next value in folder 
Value = Dir

'Continue macro with Do
Loop

'Show changes on worksheet to user
Application.ScreenUpdating = False
End Sub

Where to put the code?

1. Copy above VBA code
2. Press Alt+F11 to open the VB Editor.
3. Select your workbook in the Project Explorer
4. Press with mouse on "Insert" on the menu.
5. Press with mouse on "Module" to create a module in your workbook.
6. Paste VBA code to code module.
7. Return to Excel.

Note, make sure you save your workbook with the *.xlsm file extension. This will save the VBA code to the workbook.

Back to top

7.2. How to navigate quickly in a complex workbook using hyperlinks

Question: I have a workbook containing a lot of worksheets and data. I need a way to find certain data/sheets quickly. How can I do this?

Answer: Create a table of contents and use hyperlinks to move around in a large complex workbook.

Here is how to do this in Excel:

1. On your front sheet create a list with important workbook sheets you often visit
   
2. Press with right mouse button on on January and select Hyperlink...
3. Press with left mouse button on "Link to: A place in this document"
   
4. Type cell reference. You can link to the same sheet as many times as you want. But by using a cell reference you can link to a certain place in that sheet, creating a more sophisticated navigation system.
5. Press with left mouse button on OK!
   
6. Try press with left mouse button oning on January. Now can find important places in a workbook really quick!
7. Repeat with remaining sheets.

Get Excel sample file for this tutorial.
table-of-contents.xls (Excel 97-2003 Workbook *.xls)

Back to top

8. Filter duplicate files in a folder and subfolders

This is a follow up to my last post Compare file names in two different folder locations and their subfolders, the obvious question after reading that article is "How do I find duplicate files in a single folder and its subfolders?"

This article answers that question, there are two macros below: "FindDuplicateFiles" and "Recursive". These macros are perhaps more useful for my blog readers than the macro in my last post.

I imagine the macros would be great for finding duplicate mp3 or picture files. Note, they compare only the file names, not the file sizes.

8.1. VBA Code

Check article Compare file names in two different folder locations and their sub folders where I explain the VBA code.

Sub FindDuplicateFiles()
Dim pth1 As String
Dim arrd() As Variant
Dim arru() As Variant
ReDim arrd(0 To 2, 0)
ReDim arru(0 To 2, 0)

With Application.FileDialog(msoFileDialogFolderPicker)
.Show
pth1 = .SelectedItems(1) & "\"
End With

Sheets.Add
Set x = ActiveSheet

Application.ScreenUpdating = False
x.Range("A1") = "Duplicate files"
x.Range("A2") = "Path"
x.Range("B2") = "File name"
x.Range("C2") = "Size"
x.Range("A:F").Font.Bold = False
x.Range("A1:C2").Font.Bold = True

Recursive pth1

Lrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
x.Range("A2:C" & Lrow).Sort Key1:=x.Range("B1"), Header:=xlYes

arr1 = x.Range("A3:C" & Lrow).Value

x.Range("A3:C" & Lrow).Clear

For r1 = LBound(arr1, 1) + 1 To UBound(arr1, 1)

    If arr1(r1, 2) = arr1(r1 - 1, 2) Then
    
        arrd(0, UBound(arrd, 2)) = arr1(r1 - 1, 1)
        arrd(1, UBound(arrd, 2)) = arr1(r1 - 1, 2)
        arrd(2, UBound(arrd, 2)) = arr1(r1 - 1, 3)
        
        ReDim Preserve arrd(UBound(arrd, 1), UBound(arrd, 2) + 1)
        
        arr1(r1 - 1, 1) = ""
        arr1(r1 - 1, 2) = ""
        arr1(r1 - 1, 3) = ""
        
        chk = True
    
    Else
    
        If chk = True Then
        
            arrd(0, UBound(arrd, 2)) = arr1(r1 - 1, 1)
            arrd(1, UBound(arrd, 2)) = arr1(r1 - 1, 2)
            arrd(2, UBound(arrd, 2)) = arr1(r1 - 1, 3)
            chk = False
            
            ReDim Preserve arrd(UBound(arrd, 1), UBound(arrd, 2) + 1)
            
            arr1(r1 - 1, 1) = ""
            arr1(r1 - 1, 2) = ""
            arr1(r1 - 1, 3) = ""
        
        Else
        
            arru(0, UBound(arru, 2)) = arr1(r1 - 1, 1)
            arru(1, UBound(arru, 2)) = arr1(r1 - 1, 2)
            arru(2, UBound(arru, 2)) = arr1(r1 - 1, 3)
            
            ReDim Preserve arru(UBound(arru, 1), UBound(arru, 2) + 1)
            
            arr1(r1 - 1, 1) = ""
            arr1(r1 - 1, 2) = ""
            arr1(r1 - 1, 3) = ""
        
        End If
    
    End If

Next r1

If chk = True Then
    arrd(0, UBound(arrd, 2)) = arr1(r1 - 1, 1)
    arrd(1, UBound(arrd, 2)) = arr1(r1 - 1, 2)
    arrd(2, UBound(arrd, 2)) = arr1(r1 - 1, 3)
Else
    arru(0, UBound(arru, 2)) = arr1(r1 - 1, 1)
    arru(1, UBound(arru, 2)) = arr1(r1 - 1, 2)
    arru(2, UBound(arru, 2)) = arr1(r1 - 1, 3)
End If

x.Range("A3").Resize(UBound(arrd, 2) + 1, UBound(arrd, 1) + 1) = Application.Transpose(arrd)

x.Range("A" & UBound(arrd, 2) + 3) = "Unique files"
x.Range("A" & UBound(arrd, 2) + 4) = "Path"
x.Range("B" & UBound(arrd, 2) + 4) = "File name"
x.Range("C" & UBound(arrd, 2) + 4) = "Size"
x.Range("A" & UBound(arrd, 2) + 3 & ":C" & UBound(arrd, 2) + 4).Font.Bold = True
x.Range("A" & UBound(arrd, 2) + 5).Resize(UBound(arru, 2) + 1, UBound(arru, 1) + 1) = Application.Transpose(arru)

x.Columns("A:C").AutoFit

End Sub

Sub Recursive(FolderPath As String)
Dim Value As String, Folders() As String
Dim Folder As Variant, a As Long
ReDim Folders(0)
If Right(FolderPath, 2) = "\\" Then Exit Sub
Value = Dir(FolderPath, &H1F)
Do Until Value = ""
    If Value = "." Or Value = ".." Then
    Else
        If GetAttr(FolderPath & Value) = 16 Or GetAttr(FolderPath & Value) = 48 Then
            Folders(UBound(Folders)) = Value
            ReDim Preserve Folders(UBound(Folders) + 1)
        Else
            Lrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1
            ActiveSheet.Range("A" & Lrow) = FolderPath
            ActiveSheet.Range("B" & Lrow) = Value
            ActiveSheet.Range("C" & Lrow) = FileLen(FolderPath & Value)
        End If
    End If
    Value = Dir
Loop
For Each Folder In Folders
    Recursive FolderPath & Folder & "\"
Next Folder
End Sub

Back to top

8.2. How do I use this macro?

The easiest way to go is to get the excel file at the bottom of this post and run it from there. But if you want to copy the macro to your workbook, follow these steps:

1. Copy the code above.
2. Go to the VB Editor (Alt+F11).
3. Press with left mouse button on "Insert" on the menu.
4. Press with left mouse button on "Module".
5. Paste code to code window.
6. Return to Excel.

Back to top

8.3. How do I start the macro?

1. Go to "Developer" tab on the ribbon.
2. Press with left mouse button on "Macros" button.
3. Select macro name "FindDuplicateFiles".
4. Press with left mouse button on "Run" button.

Back to top

8.4. What happens when I run the macro?

1. Select a folder on your harddrive or network drive.
2. A new sheet is inserted.
3. Sheet is populated with data.
4. Macro ends.

Back to top

Save the macro in your personal macro workbook

If you save the macro in a personal macro workbook, you can access that macro no matter what workbook you have open.

Read this: Copy your macros to a Personal Macro Workbook

Files and folders category

User defined function category

More than 1300 Excel formulas

Excel categories

Comments (83)