0

I have file details listed in an excel sheet like file name, file name with dir, file modified date. I want to sort files which are duplicates on my harddrive and delete older versions, keeping newer versions. I have written code that deletes all files listed in column A with dir name.

Sub DeleteExample3()
    Dim c As Range, f As String
    For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp))
        f = c.Value2 & c.Offset(0, 1).Value2
       Kill f
    Next c
    On Error GoTo 0
End Sub

Snapshot of tabular dataClick to embiggen

Based on the comments, the question is:

How do I find only the newest [File Modified] date from a set of duplicate file names from [File Path] and delete all the rest?

6
  • Welcome to SO! You've told us your goal and provided your code which is fantastic. Do you actually have a question? Is your code non-functional? Are you getting an error message? Please edit your post to indicate in detail what you actually need help with.
    – FreeMan
    Mar 10, 2017 at 14:49
  • I have file names with dir. I want to sort duplicate file names first from 'B' coulmn, then from duplicate list sort out file names with older version (latest version can get from 'D' coulmn) and delete them. I just wanted latest files on machine wherever they maybe. Mar 10, 2017 at 15:00
  • What are you tried so far? It's easy to do without sorting, just use dictionary in 2 steps. First loop over filename/date pair so if dict.exists(filename) then compare dates and rewrite if newer else dict.add key:=filename item:=date. On second loop delete all stuff not presented in dict. Or are you looking for someone who will write it for you? Mar 10, 2017 at 15:12
  • 2
    OK, you've posted some code and said twice (in your OP and in your comment) that you want to remove duplicate files. Is the code you've posted doing that? If not, where does it fail? What is the problem you're having that your posted code is not solving? You'll get better answers more quickly if you don't make those who are trying to help you guess what the problem is.
    – FreeMan
    Mar 10, 2017 at 15:31
  • Actually I wanted to consider duplicate files from "B" column because these are files that I am interested in. Then go to "D" column sort according to dates -> Delete all file versions except latest one. What I have code is to delete all files. I am unable to figure out latest files to keep it and delete older ones. Mar 10, 2017 at 17:20

1 Answer 1

0

The following should do what you want and is perhaps the easiest way of accomplishing it. It's been tested but only on a limited dataset so you should proceed with caution and consider this as a starting point.

The main data structure is that of a dictionary that has keys of the filename. The values created by the newEntry function are two element Collections of which the elements are the full pathname of the file and the file date/time.

The processing occurs in two loops, the first of which populates the dictionary and deletes all duplicate files with an earlier time/date. The second removes lines from the spreadsheet for the older duplicates.

Note that only the older duplicate files are removed. The directories are not modified.

Option Explicit

Function newEntry(pa As String, dt As Date) As Collection
  Dim col As Collection
  Set col = New Collection
  col.Add pa 'filename path
  col.Add dt 'file date
  Set newEntry = col
End Function


Sub RemoveOldDuplicates()
  Dim dict As Scripting.Dictionary
  Set dict = New Scripting.Dictionary

  Dim pa As String, fn As String
  Dim dt As Date
  Dim rng As Range, c As Range
  Set rng = Range("A1", Range("A" & Rows.Count).End(xlUp))

  ' populate/update dictionary and delete duplicate files
  For Each c In rng
    pa = c.Value
    fn = c.Offset(0, 1)
    dt = CDate(c.Offset(0, 3))

    If dict.exists(fn) Then
      If dt > dict(fn)(2) Then
        Kill dict(fn)(1)
        Set dict(fn) = newEntry(pa, dt)
      Else
        Kill pa
      End If
    Else
      Set dict(fn) = newEntry(pa, dt)
    End If
  Next c

  Dim top As Integer, bot As Integer, i As Integer
  bot = rng.Cells(1, 1).row
  top = rng(rng.Count).row
  If top = bot Then Exit Sub

  ' Remove all rows of file paths that aren't in dictionary
  For i = top To bot Step -1:
    Set c = Cells(i, 1)
    fn = c.Offset(0, 1)
    If dict.exists(fn) Then
      If dict(fn)(1) <> c.Value Then
        Rows(c.row).EntireRow.Delete
      End If
    End If
  Next i

End Sub

What you might consider doing is to present the user with the latest file and the duplicates that are to be deleted and then ask whether he/she wants to do that either on a different worksheet or with a userform. At least that way the user can check if anything is wrong before performing the permanent deletions.

5
  • Nice, this is what I wanted. But how can I show user that 'these' files will be deleted. Can you write code if we can highlight the files row in table that will be deleted? Then, I will add code for msg box that will confirm user before deleting files. Mar 14, 2017 at 5:11
  • There are any # of ways of doing that. The easiest would probably be to create a new subroutine that is similar to the first for loop but instead of 'killing' the file you can highlight the associated row. You'd have to save the row in the collection that the newEntry creates simply by adding it to the collection. If you have problems you can create another question on this site. Once you have that subroutine you can use the following process: Mar 14, 2017 at 15:20
  • 1) Save your entire directory structure maybe as a daily nightly back-up, 2) run the subroutine mentioned above that highlights worksheet lines for files that are targeted for deletion (but doesn't do the deletions), 3) check each highlighted line manually after it has run to ensure it isn't deleting something that it shouldn't, and 4) once satisfied you can run RemoveOldDuplicates to perform all the deletions. Mar 14, 2017 at 15:23
  • Of course you can use RemoveOldDuplicates now - just save your files/directories and master spreadsheet as a backup, run it and then check between both sets of files (old and new) to see whether it has done what you expect. Mar 14, 2017 at 15:35
  • OK. I will try. Also will be feasible if I use 1) Conditional formatting in 1st subroutine 2) Msg box for confirmation and 3) in 2nd subroutine the above code. Mar 14, 2017 at 17:20

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.