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.

What's on this webpage

VBA code - Filter duplicate files in a folder and subfolders
Where to put the code?
How do I start the macro?
What happens when I run the macro?
Get Excel file

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

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:

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

3. How do I start the macro?

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

4. What happens when I run the macro?

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

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

Get the Excel file

Find-duplicate-files-in-a-folder-and-sub-folders.xlsm

Compare file names in two different folder locations and their sub folders
Today I would like to share a macro that compares the content in two different folders and their subfolders. It […]

Copy data from workbooks in folder and subfolders
I will in this article demonstrate a macro that automatically opens all workbooks in a folder and subfolders, one by […]

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 […]

List files in a folder and subfolders [UDF]
This article demonstrates a user defined function that lists files in a ggiven folder and subfolders. A user defined function is […]

List files in folder and create hyperlinks (VBA)
Table of Contents List files in a folder and create hyperlinks (VBA) How to navigate quickly in a complex workbook […]

Move data to workbooks
This article demonstrates a VBA macro that saves user input to a given workbook and worksheet programmatically. Macros are great […]

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 […]

Search all workbooks in a folder
Today I'll show you how to search all Excel workbooks with file extensions xls, xlsx and xlsm in a given folder for a […]

Search all workbooks in a folder and sub folders
This article demonstrates a macro that allows you to search for a text string in multiple worksheets and workbooks located […]

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 […]

Unzip files in folder and subfolders
The VBA macro demonstrated in this article lets you unzip all zip files in a folder to a destination folder […]

Which Excel files in folder are password protected?
This article explains how to check if Excel files in a given folder are password protected. The image above shows […]

Working with FILES
What's on this page Copy a file Copy and rename a file Rename a file List files in a folder […]

Comments (2)

2 Responses to “Filter duplicate files in a folder and subfolders”

rewanya says:

January 14, 2016 at 7:24 pm

I use Duplicate Files Deleter as it is very effective. It is 100% accurate and performs the scan quickly.

Reply
Rasel says:

July 22, 2020 at 6:11 am

Hey nice explanation. You showed very easy steps. Few days ago I faced same problem in my windows 10 pc, Then I searched google for"duplicate file deleter" and I used software to delete my duplicate files. It worked fine. However , Your post should help if someone will face this again . Thanks a lot.

Reply

How to comment

How to add a formula to your comment
<code>Insert your formula here.</code>

Convert less than and larger than signs
Use html character entities instead of less than and larger than signs.
< becomes < and > becomes >

How to add VBA code to your comment
[vb 1="vbnet" language=","]
Put your VBA code here.
[/vb]

How to add a picture to your comment:
Upload picture to postimage.org or imgur
Paste image link to your comment.

Contact Oscar

You can contact me through this contact form

Filter duplicate files in a folder and subfolders