Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,092
Default Macro - Cut and paste a row if duplicate

Maybe easier to read:

Sub CutOldestDupe()
Dim LRow As Long, LRow2 As Long, i As Integer, ii As Long
Dim SrcRng As Range, DestRng As Range, c As Range, c2 As Range

LRow = Worksheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
If LRow < 3 Then Exit Sub
Set SrcRng = Worksheets("Sheet1").Range("C2:G" & LRow)
Worksheets("Sheet1").Activate
SrcRng.Sort Key1:=Range("G2"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom

For i = LRow To 3 Step -1
Set c = Cells(i, 3)
c.Select
For ii = LRow - 1 To 2 Step -1
Set c2 = Cells(ii, 3)
c2.Select
If c = c2 Then
If c.Offset(, 1) = c2.Offset(, 1) Then
If c.Offset(, 2) = c2.Offset(, 2) Then
If c.Offset(, 3) = c2.Offset(, 3) Then
If c.Offset(, 4) c2.Offset(, 4) Then
LRow2 = Worksheets("Sheet2").Cells(Rows.Count,
"C").End(xlUp).Row + 1
Set SrcRng = Worksheets("sheet1").Range("C" & c2.Row & ":G" &
c2.Row)
SrcRng.Copy Worksheets("sheet2").Range("C" & LRow2)
c2.EntireRow.Delete
i = i - 1
LRow = LRow - 1
End If
End If
End If
End If
End If
Next ii
LRow = LRow - 1
Next i
End Sub


Mike F
"Mike Fogleman" wrote in message
m...
OK here it is, ignoring column B. Watch out for line wrap in the news
reader. Will send it again unindented if it is too bad to read.

Sub CutOldestDupe()
Dim LRow As Long, LRow2 As Long, i As Integer, ii As Long
Dim SrcRng As Range, DestRng As Range, c As Range, c2 As Range

LRow = Worksheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
If LRow < 3 Then Exit Sub
Set SrcRng = Worksheets("Sheet1").Range("C2:G" & LRow)
Worksheets("Sheet1").Activate
SrcRng.Sort Key1:=Range("G2"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom

For i = LRow To 3 Step -1
Set c = Cells(i, 3)
c.Select
For ii = LRow - 1 To 2 Step -1
Set c2 = Cells(ii, 3)
c2.Select
If c = c2 Then
If c.Offset(, 1) = c2.Offset(, 1) Then
If c.Offset(, 2) = c2.Offset(, 2) Then
If c.Offset(, 3) = c2.Offset(, 3) Then
If c.Offset(, 4) c2.Offset(, 4) Then
LRow2 =
Worksheets("Sheet2").Cells(Rows.Count, "C").End(xlUp).Row + 1
Set SrcRng = Worksheets("sheet1").Range("C"
& c2.Row & ":G" & c2.Row)
SrcRng.Copy Worksheets("sheet2").Range("C"
& LRow2)
c2.EntireRow.Delete
i = i - 1
LRow = LRow - 1
End If
End If
End If
End If
End If
Next ii
LRow = LRow - 1
Next i
End Sub

Mike F
"Mike Fogleman" wrote in message
m...
What is in column B? You mention it in your range to check but only want
to compare columns C-F for matching data.

Mike F
"Mike Fogleman" wrote in message
m...
I see from your second post that you want to cut and paste the oldest
date to sheet2, leaving the newest on sheet1. First I would sort sheet1
by the dates in ascending order. Then loop from the bottom up, checking
each line against the others for a match and cut and paste the oldest
date to sheet2. Deleting rows should always be done from the bottom up.
Let me create a test workbook and work on some code for this

Mike F
"Dileep Chandran" wrote in message
oups.com...

Nice thought Mike. But I am least concerned about that. Do you have a
suggetion?

Thanks
-Dileep









Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
copy multiple worksheets of a workbook, and paste onto a Word document ( either create new doc file or paste onto an existing file.) I need this done by VBA, Excel Macro Steven Excel Programming 1 October 17th 05 08:56 AM
Copy and Paste macro needs to paste to a changing cell reference loulou Excel Programming 0 February 24th 05 10:29 AM
Cut and Paste using Macro gives paste special method error Lourens Pentz Excel Programming 3 November 21st 04 10:42 PM
Macro to Paste to specific line, and continue to Paste each time on next row not over tomkarakowski[_2_] Excel Programming 1 May 28th 04 06:50 PM
Macro to Copy/Paste then Paste to Next Line tomkarakowski Excel Programming 1 May 28th 04 01:19 AM


All times are GMT +1. The time now is 10:04 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"