View Single Post
  #10   Report Post  
Posted to microsoft.public.excel.programming
Mike Fogleman Mike Fogleman is offline
external usenet poster
 
Posts: 1,092
Default Macro - Cut and paste a row if duplicate

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