Remove duplicates in Excel

[smurfhell]

I have a script that scans folders/files for anything that hasn't been accessed in the last 3 months and writes the folder name to an Excel spreadsheet. However, this creates lots of duplicate entries. Would it be easier to remove the duplicates after scanning or limit the scanning under each folder if a certain condition is met?

Here's what I got so far: (paths and dates have been changed for testing purposes)

Dim objFSO, objFolder, colFiles, objSubFolder, objSubFile, strOld, strDateDiff
Dim objexcel, r, s
strFolder = "c:\fakeproj\"
'strTar = "c:\fakemove\"
strOld = 0
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strFolder)
Set colFiles = objFolder.Files
r = 2
set objexcel = createobject("Excel.application")
objexcel.workbooks.add
objexcel.cells(1,1).value = "Folder Name"
objexcel.visible = true
For Each objFile in colFiles
strOld = objfile.DateLastModified
strDateDiff = DateDiff("d", strOld, Now)
If strDateDiff >= strOld Then
objexcel.cells(r,1).value = objFolder
end if
next
scansubfolders(objFolder)
sortsheet()
msgbox "done"
Sub scansubfolders(objfolder)
set colfolders = objfolder.subfolders
for each objsubfolder in colfolders
set colfiles = objsubfolder.files
for each objfile in colfiles
If strDateDiff >= strOld Then
objexcel.cells(r,1).value = objFolder
r = r+1
end if
next
scansubfolders(objSubFolder)
next
end sub
sub sortsheet()
Set objRange = objExcel.ActiveCell.EntireColumn
Set objRange2 = objExcel.Range("A1")
objRange.Sort objRange2,,,,,,,1
End Sub

The root folder contains about 20 subfolders, each of these with about 100 subfolders, and then one last set of subfolders. i.e.
Project -> 1000s, 2000s, 3000s, etc. -> 1124, 1426, 2075, etc. I need just the actual project number listed (2075 instead of 2000s)
I hope this post makes sense.