On Sat, 02 Jul 2005 23:06:21 +1000, John Fitzsimons wrote:
[Delete all Dupes]
Well, as my spreadsheet may have 40,000+ rows I find going from the
first to the last can be time consuming/tedious. I do know how to get
to the bottom of the selection BUT I often forget it. :-(
(Nearly) all things which can be done manually can be done by macro, too.
You should ask within Excel related groups if you need an every-day
problem solved. I don't read any. So, unfortunately, I can't recommend
you one. But if you browse through the postings you should quickly get
an idea of the knowledge which can be found inside one or another...
To demonstrate that such things *can* be done by macro I post one which
should successfully remove all dupes of a coherent area. (I've adopted
some code I use for other / similar purposes and hope nothing got
wrong on that way.):
Sub RemoveAllDupes()
'
Dim regA, regB
Dim sFormula
Dim iOffset, iCnt
Set regA = ActiveCell.CurrentRegion
iOffset = IIf(MsgBox("Has table headers?", vbYesNo, _
"Decision needed") = vbYes, 1, 0)
Set regA = regA.Offset(iOffset, 0) _
.Resize(regA.Rows.Count - iOffset, regA.Columns.Count)
regA.Offset(0, regA.Columns.Count).Resize(1, 1).Select
Selection.EntireColumn.Insert
For iCnt = regA.Columns.Count To 1 Step -1
sFormula = sFormula & "RC[-" & iCnt & "]"
sFormula = IIf(iCnt > 1, sFormula & "&""|""&", sFormula)
Next
ActiveCell.FormulaR1C1 = "=" & sFormula
regA.Offset(0, regA.Columns.Count) _
.Resize(regA.Rows.Count, 1).Select
regA.Offset(0, regA.Columns.Count) _
.Resize(1, 1).Activate
Selection.FillDown
regA.Resize(regA.Rows.Count, regA.Columns.Count + 1).Select
Selection.Sort Key1:=regA.Offset(0, regA.Columns.Count) _
.Resize(1, 1), Order1:=xlAscending, _
Header:=xlNo, Orientation:=xlTopToBottom
regA.Offset(0, regA.Columns.Count + 1).Resize(1, 1).Select
Selection.EntireColumn.Insert
Selection.EntireRow.Insert
regA.Offset(0, regA.Columns.Count + 1).Resize(1, 1).Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(RC[-1]=R[-1]C[-1],RC[-1]=R[1]C[-1]),1,0)"
regA.Offset(0, regA.Columns.Count + 1) _
.Resize(regA.Rows.Count, 1).Select
regA.Offset(0, regA.Columns.Count + 1) _
.Resize(1, 1).Activate
Selection.FillDown
regA.Offset(-1, 0) _
.Resize(regA.Rows.Count + 1, regA.Columns.Count + 2).Select
Selection.AutoFilter Field:=regA.Columns.Count + 2, Criteria1:="1"
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.AutoFilter
Selection.Delete (xlShiftUp)
regA.Offset(iOffset - 1, 0) _
.Resize(1, regA.Columns.Count + 2).Select
Selection.Insert Shift:=xlDown
regA.Offset(-1, regA.Columns.Count).Resize(1, 1).Select
Selection.EntireRow.Delete
Selection.EntireColumn.Delete
Selection.EntireColumn.Delete
regA.Resize(1, 1).Select
End Sub
It's not too beautiful, but it seems to work on Excel 97. Adjustments
for different outcomes should be easy. Ask some Excel Pro's to refine
the code if you need that.
BeAr