F
fpd833
Following up on a previous post.
I have a list of data in columns A:I. I need to find all duplicate rows in
the used range based on the data in col G, cut the all duplicates and paste
into another worksheet in the workbook.
Tom Ogilvy provided the following routine, but this leaves behind 1 of the
duplicate rows. Lets say I have 3 rows that have the same data in col G, is
it possible to
cut and past all 3 rows into the other sheet? Thanks in advance for any help
you can provide.
Thanks!
Sub ABC()
Dim rng As Range, rng1 As Range
Set rng = Intersect(ActiveSheet.UsedRange.EntireRow, _
ActiveSheet.Columns(10))
rng.Formula = "=if(Countif($G$1:G1,G1)>1,na(),"""")"
On Error Resume Next
Set rng1 = rng.SpecialCells(xlFormulas, xlErrors)
On Error GoTo 0
If Not rng1 Is Nothing Then
rng1.EntireRow.Copy Worksheets("Sheet2").Range("A1")
rng1.EntireRow.Delete
Worksheets("Sheet2").Columns(10).ClearContents
End If
ActiveSheet.Columns(10).ClearContents
End Sub
I have a list of data in columns A:I. I need to find all duplicate rows in
the used range based on the data in col G, cut the all duplicates and paste
into another worksheet in the workbook.
Tom Ogilvy provided the following routine, but this leaves behind 1 of the
duplicate rows. Lets say I have 3 rows that have the same data in col G, is
it possible to
cut and past all 3 rows into the other sheet? Thanks in advance for any help
you can provide.
Thanks!
Sub ABC()
Dim rng As Range, rng1 As Range
Set rng = Intersect(ActiveSheet.UsedRange.EntireRow, _
ActiveSheet.Columns(10))
rng.Formula = "=if(Countif($G$1:G1,G1)>1,na(),"""")"
On Error Resume Next
Set rng1 = rng.SpecialCells(xlFormulas, xlErrors)
On Error GoTo 0
If Not rng1 Is Nothing Then
rng1.EntireRow.Copy Worksheets("Sheet2").Range("A1")
rng1.EntireRow.Delete
Worksheets("Sheet2").Columns(10).ClearContents
End If
ActiveSheet.Columns(10).ClearContents
End Sub