Deleting Rows With Multiple Duplicate Column Entries

[TheBigEasy]

I realise the title is ridiculous so hopefully this explains better......

I have 31 columns of data with over 13000 rows. Some of these rows are identical across all 31 columns and i only require one instance of each.

Recording a macro worked well once but i have to do this every month and subtle changes in the data means the recorded macro doesn't work.

Any ideas?

 

[texasalynn]

post the code you have and will try to sort it out for you

 

[taigovinda]

Or on the off chance that you are using Excel 2007, you need only select all the data and use "Remove Duplicates" from the Data ribbon.

 

[TheBigEasy]

Its 2003 unfortunately. Am away from my computer now so will post it tomorrow. Thanks!

 

[TheBigEasy]

This was the macro i recorded. In red are what i consider the issues i.e. the sorting and chopping have fixed ranges because of the way i performed the macro when i recorded it originally. (To be honest, i would probably highlight the whole bloody thing in red!).

Help Please!

Sub DelLin()
'
' DelMultLin Macro
' Macro recorded 10/11/2009 by ict
'
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
'
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A2").Select
ActiveCell.FormulaR1C1 = _
"=RC[1]&RC[2]&RC[3]&RC[4]&RC[5]&RC[6]&RC[7]&RC[8]&RC[9]&RC[10]&RC[11]&RC[12]&RC[13]&RC[14]&RC[15]&RC[16]&RC[17]&RC[18]&RC[19]&RC[20]&RC[21]&RC[22]&RC[23]&RC[24]&RC[26]&RC[27]&RC[28]&RC[29]&RC[30]"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A11939")
Range("A2:A11939").Select
Columns("A:A").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight
Range("A2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[1]=R[1]C[1],1,0)"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A11939")
Range("A2:A11939").Select
Columns("A:A").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Application.CutCopyMode = False
Cells.Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Cells.Select
Selection.AutoFilter
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Selection.AutoFilter Field:=1, Criteria1:="1"
Rows("11827:11939").Select
Selection.Delete Shift:=xlUp
Cells.Select
Selection.AutoFilter
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Cells.Select
Selection.Sort Key1:=Range("E2"), Order1:=xlAscending, Key2:=Range("A2") _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
xlSortNormal
Range("C6").Select
End Sub

 

[texasalynn]

be sure to make a copy of your file before trying this.

see if this works

Sub DelLin()
'
' DelMultLin Macro
' Macro recorded 10/11/2009 by ict
'
Dim LR As Long
LR = Cells(Rows.Count, 1).End(xlUp).Row
'
Columns("A:A").Insert Shift:=xlToRight
Range("A2").FormulaR1C1 = _
"=RC[1]&RC[2]&RC[3]&RC[4]&RC[5]&RC[6]&RC[7]&RC[8]&RC[9]&RC[10]&RC[11]&RC[12]&RC[13]&RC[14]&RC[15]&RC[16]&RC[17]&RC[18]&RC[19]&RC[20]&RC[21]&RC[22]&RC[23]&RC[24]&RC[26]&RC[27]&RC[28]&RC[29]&RC[30]"
Range("A2").AutoFill Destination:=Range("A2:A" & LR)
Columns("A:A").Copy
Columns("A:A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
Columns("A:A").Insert Shift:=xlToRight
Range("A2").FormulaR1C1 = "=IF(RC[1]=R[1]C[1],1,0)"
Range("A2").AutoFill Destination:=Range("A2:A" & LR)
Columns("A:A").Copy
Columns("A:A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
Cells.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
Cells.AutoFilter Field:=1, Criteria1:="1"
LR = Cells(Rows.Count, 1).End(xlUp).Row
Rows("2:" & LR).Delete Shift:=xlUp
Cells.AutoFilter
Columns("A:B").Delete Shift:=xlToLeft
Cells.Sort Key1:=Range("E2"), Order1:=xlAscending, Key2:=Range("A2") _
    , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
    , Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
    xlSortNormal
End Sub

I have cleaned up your code as you don't generally need to select with code.

HTH

 

[TheBigEasy]

Texas, that is excellent. I love this board!

I was typing a huge message to say how i couldn't get it to work but realised that the sorting before the macro was vital to its effectiveness.

Thanks again.

TBE

 

[TheBigEasy]

HHEEEELLLLLPPPPPP!

This was running fine but now is being stopped at the red text - Need this done now ARRRGGHHH!

Sub DelLin()
'
' DelMultLin Macro
' Macro recorded 10/11/2009 by ict
'
Dim LR As Long
LR = Cells(Rows.Count, 1).End(xlUp).Row
'
Columns("A:A").Insert Shift:=xlToRight
Range("A2").FormulaR1C1 = _
"=RC[1]&RC[2]&RC[3]&RC[4]&RC[5]&RC[6]&RC[12]&RC[13]&RC[14]&RC[15]&RC[16]&RC[17]&RC[18]&RC[19]&RC[20]&RC[21]&RC[22]&RC[23]&RC[24]&RC[26]&RC[27]&RC[28]&RC[29]&RC[30]"
Range("A2").AutoFill Destination:=Range("A2:A" & LR)
Columns("A:A").Copy
Columns("A:A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Columns("A:A").Insert Shift:=xlToRight
Range("A2").FormulaR1C1 = "=IF(RC[1]=R[1]C[1],1,0)"
Range("A2").AutoFill Destination:=Range("A2:A" & LR)
Columns("A:A").Copy
Columns("A:A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Cells.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Cells.AutoFilter Field:=1, Criteria1:="1"
LR = Cells(Rows.Count, 1).End(xlUp).Row
Rows("2:" & LR).Delete Shift:=xlUp
Cells.AutoFilter
Columns("A:B").Delete Shift:=xlToLeft
Cells.Sort Key1:=Range("E2"), Order1:=xlAscending, Key2:=Range("A2") _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
xlSortNormal
End Sub