Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Cut, paste and delete
I'm trying to make a varient macro of the 'delete duplicates' theme. My co-worker wants a record of the duplicate rows that have been deleted. I've made some progress but I'm having difficulties in deleting the rows that have been cut/pasted. Code: -------------------- Sub DeleteDupRow() ' ' 'Deletes row if there is 'a duplicate found in the 'column ' Dim currentcell As Range Dim nextcell As Range Application.ScreenUpdating = False Sheets.Add 'Adds new worksheet to the left ActiveSheet.Name = "Duplicates" 'renames new worksheet ActiveSheet.Next.Select 'moves one worksheet to the right Set currentcell = ActiveCell Do While Not IsEmpty(currentcell.Offset(0, 0)) Set nextcell = currentcell.Offset(1, 0) If nextcell.Value = currentcell.Value Then currentcell.EntireRow.Cut (Worksheets("Duplicates").Range("A65536").End(xlUp ).Offset(1, 0)) End If IF CURRENTCELL.VALUE < 1 THEN 'HERE BE AN ERROR TO BE SORTED OUT CURRENTCELL.ENTIREROW.DELETE END IF Set currentcell = nextcell Loop Set currentcell = Nothing Application.ScreenUpdating = True End Sub -------------------- The emboldened bit is just the latest variation of me experimenting with solving this problem to no avail. I originally thought the 'currentcell.EntireRow.Delete' should be below the line ending in 'End(xlUp).Offset(1, 0))' but that didn't work. Any advice to where I'm going wrong? Thanks in advance :) -- Daminc ------------------------------------------------------------------------ Daminc's Profile: http://www.excelforum.com/member.php...o&userid=27074 View this thread: http://www.excelforum.com/showthread...hreadid=519277 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Cut, paste and delete
This seems to work: Code: -------------------- Sub DeleteDupRow() ' ' 'Deletes row if there is 'a duplicate found in the 'column ' Dim currentcell As Range Dim nextcell As Range Application.ScreenUpdating = False Sheets.Add 'Adds new worksheet to the left ActiveSheet.Name = "Duplicates" 'renames new worksheet ActiveSheet.Next.Select 'moves one worksheet to the right Set currentcell = ActiveCell Do While Not IsEmpty(currentcell.Offset(0, 0)) Set nextcell = currentcell.Offset(1, 0) If nextcell.Value = currentcell.Value Then currentcell.EntireRow.Copy (Worksheets("Duplicates").Range("A65536").End(xlUp ).Offset(1, 0)) End If If nextcell.Value = currentcell.Value Then currentcell.EntireRow.Delete End If Set currentcell = nextcell Loop Set currentcell = Nothing Application.ScreenUpdating = True End Sub -------------------- Is there any better way of doing this do you think? -- Daminc ------------------------------------------------------------------------ Daminc's Profile: http://www.excelforum.com/member.php...o&userid=27074 View this thread: http://www.excelforum.com/showthread...hreadid=519277 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Macro to cut/paste/delete | Excel Discussion (Misc queries) | |||
Find, Cut, Paste and Delete | Excel Worksheet Functions | |||
Copy, Paste then delete | Excel Programming | |||
If, Then, Cut, Paste, Delete HELP | Excel Programming | |||
Protect chartobjects, allow copy paste but NOT CUT (or delete) | Excel Programming |