Filter duplicate files in a folder and sub folders
This is a follow up to my last post Compare file names in two different folder locations and their sub folders, the obvious question after reading that article is "How do I find duplicate files in a single folder and its sub folders?"
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.
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
How do I use this macro?
The easiest way to go is to download 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)
- Click "Insert" on the menu
- Click "Module"
- Paste code to code window
- Return to excel
How do I start the macro?
- Go to "Developer" tab on the ribbon
- Click "Macros" button
- Select macro name "FindDuplicateFiles"
- Click "Run" button
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
Download excel *.xlsm file
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 […]
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 […]
What's on this page Copy a file Copy and rename a file Rename a file List files in a folder […]
Search all workbooks in a folder and sub folders
Search all workbooks in a folder is a popular post, I am happy so many find it useful. rusl cato […]
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 […]
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 […]
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 sub folders. […]
Find and replace a text string in file names, folder name and subfolders
The following two macros lets you rename files and folders recursively. Press Alt + F8 to open a list of macros, run […]
Macros are great for doing repetitive tasks. Two years ago I wrote a post about transferring data to worksheets. It is […]
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 […]
2 Responses to “Filter duplicate files in a folder and sub folders”
Leave a 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.
I use Duplicate Files Deleter as it is very effective. It is 100% accurate and performs the scan quickly.
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.