Macro to remove non-duplicates

[MrMatt]

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:

A	B	C	D	E
James	1	James	abc	123
Bill	8	Luke	def	456
Ted	3	Bill	ghi	789
Art	4	Ted	jkl	012
Mike	7	Art	mno	345
etc.

<tbody>
</tbody>

Desired:

A	B	C	D	E
James	1	James	abc	123
Bill	8	Bill	ghi	789
Ted	3	Ted	jkl	012
Art	4	Art	mno	345
Mike	7	Mike	pqr	678

<tbody>
</tbody>

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

Many Thanks

Matt

 

[Solosideshow]

so you want c2 through z2 to be deleted correct?

 

[Jeffrey20]

Something like this should work...

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.

 

[Solosideshow]

Can you post the workbook.. so i can make it work for your book.

 

[Solosideshow]

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:

A	B	C	D	E
James	1	James	abc	123
Bill	8	Luke	def	456
Ted	3	Bill	ghi	789
Art	4	Ted	jkl	012
Mike	7	Art	mno	345
etc.

<tbody>
</tbody>

Desired:

A	B	C	D	E
James	1	James	abc	123
Bill	8	Bill	ghi	789
Ted	3	Ted	jkl	012
Art	4	Art	mno	345
Mike	7	Mike	pqr	678

<tbody>
</tbody>

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

Many Thanks

Matt

I though i might have had it.. but just can't rap my code into it..

 

[MrMatt]

so you want c2 through z2 to be deleted correct?

That's correct.

 

[MrMatt]

Something like this should work...

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.

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

 

[Jeffrey20]

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?

 

[Peter_SSs]

Assuming the data has headings, and column F available to use as a helper, try this in a copy of your workbook.

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

 

[MrMatt]

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?

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