Duplicate rows based on one column - how to delete, based on value of another column???

[Andrew van den Berg]

The following situation in a file with tens of thousand of rows:
Column M Column N
47-4068 1
47-4677 1
47-4084 1
47-4084 2
47-4085 1
47-4085 2

What to do if i want to delete the bold rows (duplicate values in column M and cell value in column N is 1)???
Do i need a Macro for this? pls explain how i need to proceed then (i am a basic user).
Thanks!!!!
<!-- / message -->

 

[hiker95]

Andrew van den Berg,

Before I post the macro, what is the last used column in your raw data worksheet?

 

[Andrew van den Berg]

The last column is column N ("AvdB 2").

Thanks and BR

 

[hiker95]

Andrew van den Berg,


Sample raw data before the macro:

Excel Workbook
	M	N
1	AvdB 1	AvdB 2
2	7	1
3	7	2
4	20	1
5	20	2
6	27	2
7	27	2
8	27	2
9	30	1
10	30	2
11	31	1
12	31	2
13	32	1
14	32	2
15	33	1
16	33	2
17	34	1
18	34	2
19
Sheet1

After the macro:

Excel Workbook
	M	N
1	AvdB 1	AvdB 2
2	7	2
3	20	2
4	27	2
5	27	2
6	27	2
7	30	2
8	31	2
9	32	2
10	33	2
11	34	2
12
13
14
15
16
17
18
19
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub DelDupeRowsV5()
' hiker95, 07/05/2011
' http://www.mrexcel.com/forum/showthread.php?t=561746
Dim LR As Long
If Range("M1") <> "AvdB 1" And Range("N1") <> "AvdB 2" Then
  MsgBox "The titles in cells M1 and N1 are not correct - macro terminated!"
  Exit Sub
End If
Application.ScreenUpdating = False
LR = Cells(Rows.Count, "M").End(xlUp).Row
Range("P2").Formula = "=COUNTIF($M$2:$M$" & LR & ",M2)"
Range("P2").AutoFill Destination:=Range("P2:P" & LR)
With Range("P2:P" & LR)
  .Value = .Value
End With
Range("Q2").FormulaArray = "=MAX(IF($M$2:$M$" & LR & "=M2,$N$2:$N$" & LR & "))"
Range("Q2").AutoFill Destination:=Range("Q2:Q" & LR)
With Range("Q2:Q" & LR)
  .Value = .Value
End With
Range("R2").Formula = "=IF(N2<Q2,"""",N2)"
Range("R2").AutoFill Destination:=Range("R2:R" & LR)
With Range("R2:R" & LR)
  .Value = .Value
End With
On Error Resume Next
Range("R2:R" & LR).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
Range("P2:R" & LR).Clear
Application.ScreenUpdating = True
End Sub

Then run the DelDupeRowsV5 macro.

 

[hiker95]

Andrew van den Berg,


Not all the code got posted.




Option Explicit
Sub DelDupeRowsV5()
' hiker95, 07/05/2011
' http://www.mrexcel.com/forum/showthread.php?t=561746
Dim LR As Long
If Range("M1") <> "AvdB 1" And Range("N1") <> "AvdB 2" Then
MsgBox "The titles in cells M1 and N1 are not correct - macro terminated!"
Exit Sub
End If
Application.ScreenUpdating = False
LR = Cells(Rows.Count, "M").End(xlUp).Row
Range("P2").Formula = "=COUNTIF($M$2:$M$" & LR & ",M2)"
Range("P2").AutoFill Destination:=Range("P2:P" & LR)
With Range("P2:P" & LR)
.Value = .Value
End With
Range("Q2").FormulaArray = "=MAX(IF($M$2:$M$" & LR & "=M2,$N$2:$N$" & LR & "))"
Range("Q2").AutoFill Destination:=Range("Q2:Q" & LR)
With Range("Q2:Q" & LR)
.Value = .Value
End With
Range("R2").Formula = "=IF(N2<Q2,"""",N2)"
Range("R2").AutoFill Destination:=Range("R2:R" & LR)
With Range("R2:R" & LR)
.Value = .Value
End With
On Error Resume Next
Range("R2:R" & LR).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
Range("P2:R" & LR).Clear
Application.ScreenUpdating = True
End Sub

 

[hiker95]

Andrew van den Berg,


Not all the code got posted.


See my Private Message to you (top right hand corner of MrExcel, Welcome, Andrew van den Berg., Private Messages:

 

[hiker95]

Sorry, still having a problem posting the code.

 

[hiker95]

Andrew van den Berg,

The code I posted in my Reply #24 looks to be complete.



Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.



Option Explicit
Sub DelDupeRowsV5()
' hiker95, 07/05/2011
' http://www.mrexcel.com/forum/showthread.php?t=561746
Dim LR As Long
If Range("M1") <> "AvdB 1" And Range("N1") <> "AvdB 2" Then
MsgBox "The titles in cells M1 and N1 are not correct - macro terminated!"
Exit Sub
End If
Application.ScreenUpdating = False
LR = Cells(Rows.Count, "M").End(xlUp).Row
Range("P2").Formula = "=COUNTIF($M$2:$M$" & LR & ",M2)"
Range("P2").AutoFill Destination:=Range("P2:P" & LR)
With Range("P2:P" & LR)
.Value = .Value
End With
Range("Q2").FormulaArray = "=MAX(IF($M$2:$M$" & LR & "=M2,$N$2:$N$" & LR & "))"
Range("Q2").AutoFill Destination:=Range("Q2:Q" & LR)
With Range("Q2:Q" & LR)
.Value = .Value
End With
Range("R2").Formula = "=IF(N2 Range("R2").AutoFill Destination:=Range("R2:R" & LR)
With Range("R2:R" & LR)
.Value = .Value
End With
On Error Resume Next
Range("R2:R" & LR).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
Range("P2:R" & LR).Clear
Application.ScreenUpdating = True
End Sub




Then run the DelDupeRowsV5 macro.



If the above does not work correctly then see my Private Message to you.