Macro to remove non-duplicates

M

MrMatt

New Member
Joined
Apr 26, 2012
Messages
30
Hi

I have a Conditional Filter on Columns A and C to highlight duplicates.

What I'm trying to achieve is a macro that finds the non-duplicates in Column C (e.g. Luke) and then deletes that value and all subsequent values to the right, shifting the cells below up.

Actual:
[TABLE="width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]James[/TD]
[TD]1[/TD]
[TD]James[/TD]
[TD]abc[/TD]
[TD]123[/TD]
[/TR]
[TR]
[TD]Bill[/TD]
[TD]8[/TD]
[TD]Luke[/TD]
[TD]def[/TD]
[TD]456[/TD]
[/TR]
[TR]
[TD]Ted[/TD]
[TD]3[/TD]
[TD]Bill[/TD]
[TD]ghi[/TD]
[TD]789[/TD]
[/TR]
[TR]
[TD]Art[/TD]
[TD]4[/TD]
[TD]Ted[/TD]
[TD]jkl[/TD]
[TD]012[/TD]
[/TR]
[TR]
[TD]Mike[/TD]
[TD]7[/TD]
[TD]Art[/TD]
[TD]mno[/TD]
[TD]345[/TD]
[/TR]
[TR]
[TD]etc.[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Desired:
[TABLE="width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]James[/TD]
[TD]1[/TD]
[TD]James[/TD]
[TD]abc[/TD]
[TD]123[/TD]
[/TR]
[TR]
[TD]Bill[/TD]
[TD]8[/TD]
[TD]Bill[/TD]
[TD]ghi[/TD]
[TD]789[/TD]
[/TR]
[TR]
[TD]Ted[/TD]
[TD]3[/TD]
[TD]Ted[/TD]
[TD]jkl[/TD]
[TD]012[/TD]
[/TR]
[TR]
[TD]Art[/TD]
[TD]4[/TD]
[TD]Art[/TD]
[TD]mno[/TD]
[TD]345[/TD]
[/TR]
[TR]
[TD]Mike[/TD]
[TD]7[/TD]
[TD]Mike[/TD]
[TD]pqr[/TD]
[TD]678[/TD]
[/TR]
</tbody>[/TABLE]

Any suggestions on how to achieve this would be much appreciated.

Many Thanks

Matt
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Sort by date Sort by votes
Something like this should work...

Code: 
Sub Macro1()

Dim x As Long
Dim cll As Range

For Each cll In Selection
x = Application.WorksheetFunction.CountIf(ActiveSheet.Range("A:A"), cll)
If x = 0 Then
Range("C" & cll.Row & ":E" & cll.Row).Delete Shift:=xlUp
End If
Next cll

End Sub

Select the cells in C that you want to check, then it will check if they appear in Column A, if not then it deletes the corresponding cells from C to E.
 
Upvote 0
MrMatt said:
Hi

I have a Conditional Filter on Columns A and C to highlight duplicates.

What I'm trying to achieve is a macro that finds the non-duplicates in Column C (e.g. Luke) and then deletes that value and all subsequent values to the right, shifting the cells below up.

Actual:
[TABLE="width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]James[/TD]
[TD]1[/TD]
[TD]James[/TD]
[TD]abc[/TD]
[TD]123[/TD]
[/TR]
[TR]
[TD]Bill[/TD]
[TD]8[/TD]
[TD]Luke[/TD]
[TD]def[/TD]
[TD]456[/TD]
[/TR]
[TR]
[TD]Ted[/TD]
[TD]3[/TD]
[TD]Bill[/TD]
[TD]ghi[/TD]
[TD]789[/TD]
[/TR]
[TR]
[TD]Art[/TD]
[TD]4[/TD]
[TD]Ted[/TD]
[TD]jkl[/TD]
[TD]012[/TD]
[/TR]
[TR]
[TD]Mike[/TD]
[TD]7[/TD]
[TD]Art[/TD]
[TD]mno[/TD]
[TD]345[/TD]
[/TR]
[TR]
[TD]etc.[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Desired:
[TABLE="width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]James[/TD]
[TD]1[/TD]
[TD]James[/TD]
[TD]abc[/TD]
[TD]123[/TD]
[/TR]
[TR]
[TD]Bill[/TD]
[TD]8[/TD]
[TD]Bill[/TD]
[TD]ghi[/TD]
[TD]789[/TD]
[/TR]
[TR]
[TD]Ted[/TD]
[TD]3[/TD]
[TD]Ted[/TD]
[TD]jkl[/TD]
[TD]012[/TD]
[/TR]
[TR]
[TD]Art[/TD]
[TD]4[/TD]
[TD]Art[/TD]
[TD]mno[/TD]
[TD]345[/TD]
[/TR]
[TR]
[TD]Mike[/TD]
[TD]7[/TD]
[TD]Mike[/TD]
[TD]pqr[/TD]
[TD]678[/TD]
[/TR]
</tbody>[/TABLE]

Any suggestions on how to achieve this would be much appreciated.

Many Thanks

Matt
Click to expand...

I though i might have had it.. but just can't rap my code into it..
 
Upvote 0
Jeffrey20 said:
Something like this should work...

Code: 
Sub Macro1()

Dim x As Long
Dim cll As Range

For Each cll In Selection
x = Application.WorksheetFunction.CountIf(ActiveSheet.Range("A:A"), cll)
If x = 0 Then
Range("C" & cll.Row & ":E" & cll.Row).Delete Shift:=xlUp
End If
Next cll

End Sub

Select the cells in C that you want to check, then it will check if they appear in Column A, if not then it deletes the corresponding cells from C to E.
Click to expand...

This sort of works :) but I'm having to click on each individual cell. If I filter to highlight the non-matching cells, it doesn't work. I'm offline for the remainder of the day but this is a good start so I'll tinker with the macro tomorrow and provide a further update then.

Thanks for your help so far.

Matt
 
Upvote 0
Dont filter anything just select all the cells in column C that you want to check... For example: select from C2 to C20... and then run the macro...

Also you can easily change "For Each cll In Selection" for something like "For Each cll In Range("C2:C20")" and thus having a predefined range to work at... the last row could easily be determined by code if it's not gonna be the same always...

You can also change "Range("C" & cll.Row & ":E" & cll.Row).Delete Shift:=xlUp" from "E" to any other last column you want to delete. I put "E" since that's the last one in your example.

I can help you, but I'll need a little more detail... for example, do you have any more data in Column C? or all the data is names-to-check? do Column C has a header?
 
Last edited:
Upvote 0
Assuming the data has headings, and column F available to use as a helper, try this in a copy of your workbook.
Code: 
Sub rDeleteNonDupes()
  Dim rDel As Range
  
  Application.ScreenUpdating = False
  Range("F2").Formula = "=COUNTIF(A:A,C2)=0"
  With Range("C1", Range("E" & Rows.Count).End(xlUp))
    .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("F1:F2"), Unique:=False
    On Error Resume Next
    Set rDel = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlVisible)
    ActiveSheet.ShowAllData
    On Error GoTo 0
  End With
  If Not rDel Is Nothing Then
    rDel.Delete Shift:=xlUp
  End If
  Range("F2").ClearContents
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
Jeffrey20 said:
Dont filter anything just select all the cells in column C that you want to check... For example: select from C2 to C20... and then run the macro...

Also you can easily change "For Each cll In Selection" for something like "For Each cll In Range("C2:C20")" and thus having a predefined range to work at... the last row could easily be determined by code if it's not gonna be the same always...

You can also change "Range("C" & cll.Row & ":E" & cll.Row).Delete Shift:=xlUp" from "E" to any other last column you want to delete. I put "E" since that's the last one in your example.

I can help you, but I'll need a little more detail... for example, do you have any more data in Column C? or all the data is names-to-check? do Column C has a header?
Click to expand...

Thanks Jeffrey, it works much better with For Each cll in Range. Rather than calculating the last row I just put in a high value row that I know is blank ("C2:C500") and it works well on some test data. I'll test it with my real data shortly and update you.

Thanks again.

Matt
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
Row by row comparison between 2 sheets - conditional formatting (changes/duplicates)
Replies
2
Views
492
crtk09
C
O
  • Question Question
If Active cell is in column F then..
Replies
2
Views
3K
omairhe
O
P
  • Solved
Need Formula for conditional Formatting
2
Replies
10
Views
1K
Joe4
Joe4
P
  • Question Question
Formula for conditional format to highlight a row from column A to column Q
Replies
4
Views
484
etaf
etaf
E
  • Question Question
VBA to send email based on cells' value to recipients in excel sheet and include cell's value in the email's body
Replies
0
Views
2K
Eraclis
E

Forum statistics

Threads
1,223,214
Messages
6,170,772
Members
452,353
Latest member
strainu

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top