Modify duplicate code
Sub DeleteDuplicatesAnyCol()
Dim sht As Worksheet, sht2 As Worksheet Dim rng As Range Dim fndrng As Range Dim mycell Dim lookupcol As Integer, i As Integer lookupcol = 1 ' for example Column E - replace with 1 if you want to go with Column A Set sht = ActiveSheet Set rng = sht.Range(sht.Cells(1, lookupcol), sht.Cells(65536, lookupcol).End(xlUp)) Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set sht2 = Worksheets.Add sht2.Name = "Deleted" i = 1 sht.Activate For Each mycell In rng.Cells Set fndrng = rng.Find(mycell.Value, mycell, xlValues, xlWhole) Do Until fndrng.Row = mycell.Row sht.Rows(fndrng.Row).Copy Destination:=sht2.Rows(i) i = i + 1 sht.Rows(fndrng.Row).Delete Set fndrng = rng.FindNext(mycell) Loop Next mycell Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub I am trying to modify this code to pull in both of the duplicate rows into the new worksheet "deleted". Currently it is only pulling in one row. This would save me a bunch of time if it is possible. Thanks in advance. -Michael |
All times are GMT +1. The time now is 02:26 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com