Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro - Cut and paste a row if duplicate
Hello Everybody,
Can anybody help me with a macro which look up A1:F1000 and cut and paste and then delete the entire row which is a duplicate? For instance: If data in A1, B1, C1, D1.....F1 is repeating in A5, B5, C5, D5....F5, delete the entire row (5th row or 1st row based on the latest date). Date will be given in the column G. Thanks in advance -Dileep |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro - Cut and paste a row if duplicate
Dileep,
Glad I can finally help someone with something...There is a program called "Duplicate Master" that will do this for you. See the hyperlink below...I'm not sure if you are trying to do this for your own programming self worth or if your just looking to get this done...The link below will provide you with the end result if your just looking to get it done... http://members.iinet.net.au/~brettdj/DM.php Let me know if this works out... =) -Todd On a personal note...This ones for you Tom O. as I can only dream to be as good as you when it comes to Excel and VB Coding... Dileep Chandran wrote: Hello Everybody, Can anybody help me with a macro which look up A1:F1000 and cut and paste and then delete the entire row which is a duplicate? For instance: If data in A1, B1, C1, D1.....F1 is repeating in A5, B5, C5, D5....F5, delete the entire row (5th row or 1st row based on the latest date). Date will be given in the column G. Thanks in advance -Dileep |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro - Cut and paste a row if duplicate
Sorry, I dont want a program. I just need the code. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro - Cut and paste a row if duplicate
I found this in VB HELP...Maybe you can alter the code to get it to do
what you want... This example sorts the data in a column of the worksheet specified and then deletes rows that contain duplicate data. Sub DeleteColumnDupes(strSheetName As String, strColumnLetter As String) Dim strColumnRange As String Dim rngCurrentCell As Range Dim rngNextCell As Range strColumnRange = strColumnLetter & "1" Worksheets(strSheetName).Range(strColumnRange).Sor t _ Key1:=Worksheets(strSheetName).Range(strColumnRang e) Set rngCurrentCell = Worksheets(strSheetName).Range(strColumnRange) Do While Not IsEmpty(rngCurrentCell) Set rngNextCell = rngCurrentCell.Offset(1, 0) If rngNextCell.Value = rngCurrentCell.Value Then rngCurrentCell.EntireRow.Delete End If Set rngCurrentCell = rngNextCell Loop End Sub Dileep Chandran wrote: Sorry, I dont want a program. I just need the code. |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro - Cut and paste a row if duplicate
Thanks. But I need to check multiple values. ie not only in one column.
I need to check if name, street address, city and state are repeating. (C2 to F2). If all the data in columns C2 to F2 are repeating in the range B2:F1000, I have to cut and paste the data to another sheet based on the latest date given in Column G. Means, We have to keep the latest dates data. Is my question clear? Thank you for your help. -Dileep |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro - Cut and paste a row if duplicate
This can be done, but my question to you is what if John Smith moved to a
different address? Neither would be pasted to sheet2. It appears you are not interested in keeping John Smith's data up to date on sheet2, but keeping track of how long John Smith has lived at his current address. Is this what you intend? Mike F "Dileep Chandran" wrote in message ups.com... Thanks. But I need to check multiple values. ie not only in one column. I need to check if name, street address, city and state are repeating. (C2 to F2). If all the data in columns C2 to F2 are repeating in the range B2:F1000, I have to cut and paste the data to another sheet based on the latest date given in Column G. Means, We have to keep the latest dates data. Is my question clear? Thank you for your help. -Dileep |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro - Cut and paste a row if duplicate
Nice thought Mike. But I am least concerned about that. Do you have a suggetion? Thanks -Dileep |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro - Cut and paste a row if duplicate
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 |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro - Cut and paste a row if duplicate
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 |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
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 | Excel Programming | |||
Copy and Paste macro needs to paste to a changing cell reference | Excel Programming | |||
Cut and Paste using Macro gives paste special method error | Excel Programming | |||
Macro to Paste to specific line, and continue to Paste each time on next row not over | Excel Programming | |||
Macro to Copy/Paste then Paste to Next Line | Excel Programming |