Delete duplicate files ending in .xls

[howard]

I would like all duplicate files on Col A on sheet3 ending in .xls to be deleted


march sales.xls
march sales.xlsm
sept sales.xls

I only want march sales.xls to be deleted



Your assistance in this regard is most appreciated

 

[John_w]

Try this on a copy of the folder containing the .xls and .xlsm files (the folderPath variable). File names start in A2.

Public Sub Delete_XLS_with_XLSM_Duplicate()

    Dim fileCells As Range, file As Range
    Dim folderPath As String
    Dim xlsmRow As Variant
    
    folderPath = "C:\Path\To\Folder\"   'CHANGE THIS
    
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    
    With Worksheets("Sheet3")
        Set fileCells = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
        For Each file In fileCells
            If Right(file.Value, 4) = ".xls" Then
                xlsmRow = Application.Match(Replace(file.Value, ".xls", ".xlsm"), fileCells, 0)
                If Not IsError(xlsmRow) Then
                    If Dir(folderPath & .Cells(xlsmRow, "A").Value) <> vbNullString Then
                        Kill folderPath & .Cells(xlsmRow, "A").Value
                        MsgBox "Deleted " & folderPath & .Cells(xlsmRow, "A").Value
                    End If
                End If
            End If
        Next
    End With
    
End Sub

 

[howard]

Thanks for your help-much appreciated