Delete duplicate files that begin with data from A:

[scotsrule08]

Good day,

I am trying to run a macro that will autmatically delete one copy of a duplicate file based on the first 9 characters of the file.
These 9 characters are found in row A:

So I would need to select what folder this Macro would run in, and then list in column A: the first 9 characters of the file name, then it would delete any extra duolicates and keep only one copy.

I have been playing with this and am struggling.


TIA

 

[Yongle]

Does column A contain the full name of the file that you want to retain or only the first 9 characters of the file name?

If only first 9 characters then which file is the correct one to retain?

Rows are numbered, so have assumed you are referring to column A. Please clarify.

 

[scotsrule08]

Thank you for your response. To clarify,
Column A only contains the first 9 characters of the file name and not the whole name.

And I would love it if instead of deleting the files it moved them to a separate folder (folder could be called duplicates)
Ideally the oldest files would be the ones to move to the duplicate folder. For example.

File name: Date modified:
624879619-05-17-18.xlsx 05/17/2018
624879619-05-30-18.xlsx. 05/30/2018
624879619-06-10-18.xlsx. 06/10/2018

What I would like to happen is to move the two oldest files (05/17/18 & 05/30/2018) to a seperate folder.

And yes I am sorry, Column A will be the account number column which is the first 9 characters of the file extension.

 

[Yongle]

will look at this tomorrow for you

 

[scotsrule08]

Thank you!

 

[Yongle]

The code below can be tested on your live data - it does not change anything

To test
- paste the code into a new standard module
- amend strings for OrigFldr and DupFldr (remember to end both strings with \ )
- run MainSub (from the sheet containing the account numbers)
- the code assumes account numbers begin in A2 (amend if necessary)
- list of files to be moved is printed to the Immediate Window using Debug.Print
- to display the Immediate Window (in VBA area) click View \ Immediate Window

After testing (to enable files to be moved)

[B][I]Replace[/I][/B]
[COLOR=#ff0000]If strFile <> LatestFile Then Debug.Print "move " & OrigFldr & strFile & " to " & DupFldr & strFile[/COLOR]
[B][I]with[/I][/B]
If strFile <> LatestFile Then oFS.MoveFile Source:=OrigFldr & strFile, Destination:=DupFldr & strFile

Option Explicit
Const OrigFldr = "[COLOR=#000080]C:\Test\AccountFiles\[/COLOR]"                'end with "\"
Const DupFldr = "[COLOR=#000080]C:\Test\AccountFiles\Duplicates\[/COLOR]"      'end with "\"

Sub MainSub()            'Run from sheet containing the account numbers
    Dim AccountNo As String, accRng As Range, cel As Range
    Set accRng = Range("[COLOR=#000080]A2[/COLOR]", Range("A" & Rows.Count).End(xlUp))
    For Each cel In accRng
        AccountNo = Format(cel.Value, "000000000")
        MoveFiles (AccountNo)
    Next cel
End Sub

Private Sub MoveFiles(AccountNo As String)

Dim LatestFile As String, strFile As String, fdate, oDate, oFS As Object
Set oFS = CreateObject("Scripting.FileSystemObject")

'determine latest file
    strFile = Dir(OrigFldr & AccountNo & "*.xlsx")
    Do While strFile <> ""
        fdate = oFS.GetFile(strFile).DateCreated
        If fdate > oDate Then
            oDate = fdate
            LatestFile = strFile
        End If
        strFile = Dir
    Loop

'move earlier fies
    strFile = Dir(OrigFldr & AccountNo & "*.xlsx")
    Do While strFile <> ""
        [COLOR=#ff0000]If strFile <> LatestFile Then Debug.Print "move " & OrigFldr & strFile & " to " & DupFldr & strFile[/COLOR]     
        strFile = Dir
    Loop

'tidy up
    Set oFS = Nothing
    oDate = ""
    fdate = ""

End Sub

 

[scotsrule08]

Good day,

Unfortunately when I run the test Macro nothing shows up in the Immediate window. To double check things I even made a list of account numbers that were for sure in the folder the macro was searching for and still nothing.

Any suggestions?

 

[Yongle]

Post the code you used in its entirety and I will look at it - it will be something very minor
Also post the values A2 to A5

 

[scotsrule08]

Due to security reasons I cannot post the exact code. ?

 

[Yongle]

That makes life rather difficult
Tomorrow, I will post a few lines of code to help determine what your problem may be.