Macro to remove duplicate workbook names on sheet1 if workbook contains .xls

[howard]

I have several workbook name extracted to sheet1 that end in .xls or .xlsm


I would like a macro to delete only those rows where the workbook name have been duplicated and contains .xls


Eg M_BR1 TB.xls
M_BR1 TB.xlsm
M_BR2 TB.xls
M_BR3 TB.xls
M_BR3 TB.xlsm


In this example only the row containing M_BR1 TB.xls &M_BR3 TB.xls are to be deleted


Your assistance in this regard is most appreciated

 

[Akuini]

Maybe this:
Assuming data in col A

[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1088724a()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1088724-macro-remove-duplicate-workbook-names-sheet1-if-workbook-contains-xls.html[/COLOR][/I]
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] rg [COLOR=Royalblue]As[/COLOR] Range
[COLOR=Royalblue]Dim[/COLOR] va, vb
[COLOR=Royalblue]Dim[/COLOR] d [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Object[/COLOR]

[COLOR=Royalblue]Set[/COLOR] rg = Range([COLOR=brown]"A1"[/COLOR], Cells(Rows.count, [COLOR=brown]"A"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp))
va = rg
[COLOR=Royalblue]ReDim[/COLOR] vb([COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR]), [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]2[/COLOR])

[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])
    vb(i, [COLOR=crimson]1[/COLOR]) = Split(va(i, [COLOR=crimson]1[/COLOR]), [COLOR=brown]"."[/COLOR])([COLOR=crimson]0[/COLOR])
    vb(i, [COLOR=crimson]2[/COLOR]) = Split(va(i, [COLOR=crimson]1[/COLOR]), [COLOR=brown]"."[/COLOR])([COLOR=crimson]1[/COLOR])
[COLOR=Royalblue]Next[/COLOR]


[COLOR=Royalblue]Set[/COLOR] d = CreateObject([COLOR=brown]"scripting.dictionary"[/COLOR])
d.CompareMode = vbTextCompare

[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])
    [COLOR=Royalblue]If[/COLOR] d.Exists(vb(i, [COLOR=crimson]1[/COLOR])) [COLOR=Royalblue]Then[/COLOR]
    d(vb(i, [COLOR=crimson]1[/COLOR])) = [COLOR=crimson]2[/COLOR]
    [COLOR=Royalblue]Else[/COLOR]
    d(vb(i, [COLOR=crimson]1[/COLOR])) = [COLOR=crimson]1[/COLOR]
    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
[COLOR=Royalblue]Next[/COLOR]

[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(vb, [COLOR=crimson]1[/COLOR])
x = vb(i, [COLOR=crimson]1[/COLOR])
        [COLOR=Royalblue]If[/COLOR] d.Exists(x) [COLOR=Royalblue]And[/COLOR] d(x) = [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]And[/COLOR] LCase(vb(i, [COLOR=crimson]2[/COLOR])) = [COLOR=brown]"xls"[/COLOR] [COLOR=Royalblue]Then[/COLOR]
        Range([COLOR=brown]"A"[/COLOR] & i) = [COLOR=brown]"FALSE"[/COLOR]
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
[COLOR=Royalblue]Next[/COLOR]
rg.SpecialCells(xlConstants, xlLogical).EntireRow.Delete

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]

 

[footoo]

A macro can be created from the macro recorder. Assuming the names are in column A :
• Sort column A (Z-A)
• Insert a column at column A
• Copy column B and paste to column A
• Select column A
• Find ".xlsm", Replace ""
• Find ".xls",Replace ""
• Select columns A:B
• Remove Duplicates (Data Tools) - column A
• Delete column A

 

[howard]

Thanks for help, much appreciated

 

[howard]

Hi Akuini


Thanks for the help. I get a compile error : Variance not defined

See below

 x = vb(i, 1)

Kindly test & amend code

 

[Akuini]

Hi Akuini


Thanks for the help. I get a compile error : Variance not defined

See below

 x = vb(i, 1)

Kindly test & amend code

Sorry, forget to declare variable x.
Just add 1 line:

Dim x As String

in the declare section

 

[howard]

Thanks for update. It now works perfectly

 

[Akuini]

You're welcome, glad to help, & thanks for the feedback.