[example file inside] Need macro that cuts and pastes out rows whose Column B value is unique and Column C value is a duplicate.

[Tardisgx]

What I need is a little more than what I could fit in the title the 3 steps are illustrated below and there is a gdrive link for the example file. (I could not work out how to create editable cells in a post; (tried it in a test thread).

Put simply I have titles associated with codes. I need to edit titles so they are unique from other titles with different codes
and delete same code & same title duplicates. The issue is I cannot just delete or highlight duplicate expect 1st based on 1 column because it's 2 columns i'm keeping in mind; I can't cut out "multiple sections".

I've previously used these conditional formatting rules to filter by colour to find which titles need to be changed but it is too unreliable because the order sorting can miss titles that are not next to each other even when sorted by a-z.
=(B2=B1)*(A2<>A1) =(B2=B3)*(A2<>A3)

Any help is appreciated.

https://imgur.com/a/AjikIn2

https://drive.google.com/open?id=1lC-z1OH2n5NlcREG9TKOWAkLM8rXrz-l

 

[Fluff]

How about

Sub DeDupe()
   Dim Cl As Range, rng As Range
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("B2", Range("B" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value & "|" & Cl.Offset(, 1).Value) Then
            .Add Cl.Value & "|" & Cl.Offset(, 1).Value, Nothing
         Else
            If rng Is Nothing Then Set rng = Cl Else Set rng = Union(rng, Cl)
         End If
      Next Cl
      If Not rng Is Nothing Then rng.EntireRow.Delete
      Set rng = Nothing
      Range("a2").Value = 1
      Range("A2").AutoFill Range("A2", Range("B" & Rows.Count).End(xlUp).Offset(, -1)), xlFillSeries
      .RemoveAll
      For Each Cl In Range("C2", Range("C" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            .Add Cl.Value, Cl
         Else
            If rng Is Nothing Then Set rng = Union(Cl, .Item(Cl.Value)) Else Set rng = Union(rng, Cl, .Item(Cl.Value))
         End If
      Next Cl
      If Not rng Is Nothing Then
         rng.EntireRow.Copy Sheets("sheet2").Range("A1")
         rng.Offset(, -1).ClearContents
         rng.ClearContents
      End If
   End With
End Sub

 

[Rick Rothstein]

Put simply I have titles associated with codes. I need to edit titles so they are unique from other titles with different codes and delete same code & same title duplicates.

https://imgur.com/a/AjikIn2

https://drive.google.com/open?id=1lC-z1OH2n5NlcREG9TKOWAkLM8rXrz-l

Please clarify... in the pictures you posted, you said "delete duplicate Rows except first duplicate" for the first step, but in looking at the table you showed in the second step, it is obvious that you deleted the first duplicate value and kept the second. It is alright if you wanted to retain the first duplicate, but then please explain what should happen it there are three (or more) duplicates... what should be retained, the second or last duplicated value? Or was what you typed correct and the table you posted in your example was wrongly constructed?

 

[Tardisgx]

Ok sorry let me clarify [Same Code Same title] duplicates are redundant; their should only be 1 copy.

It does not matter how many duplicates there are or which duplicate(s) are kept or deleted. I've realised what i'm saying is delete [duplicate rows] which I can do if I concatenate the whole row into 1 cell; that puts all the data into 1 column by which to delete duplicate rows via kutools. Dunno about the rest tho.

 

[Tardisgx]

I'm looking at this kind of baffled it looks to have worked; I'll try it on my full sized workbook changing the values appropriately this afternoon; thank you what Excel necronomicon do you have to consult to learn what you know, I dig it.

 

[Rick Rothstein]

Here is another macro that you can consider...

[table="width: 500"]
[tr]
	[td]Sub DeDupe2()
  Dim LastRow As Long, UnusedCol As Long
  LastRow = Cells(Rows.Count, "B").End(xlUp).Row
  UnusedCol = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious, , , False).Column + 1
  With Range(Cells(2, UnusedCol), Cells(LastRow, UnusedCol))
    .Formula = "=IF(COUNTIFS(B$2:B2,B2,C$2:C2,C2)=1,"""",""X"")"
    .Value = .Value
  End With
  On Error Resume Next
  Columns(UnusedCol).SpecialCells(xlConstants).EntireRow.Delete
  LastRow = Cells(Rows.Count, "B").End(xlUp).Row
  Range("A2:A" & LastRow) = Evaluate("ROW(1:" & LastRow & ")")
  With Range(Cells(2, UnusedCol), Cells(LastRow, UnusedCol))
    .Formula = "=IF(COUNTIF(C$2:C" & LastRow & ",C2)>1,""X"","""")"
    .Value = .Value
  End With
  With Columns(UnusedCol).SpecialCells(xlConstants)
    .EntireRow.Copy Sheets("Sheet2").Range("A1")
    Intersect(Columns("B:C"), .EntireRow).ClearContents
    .ClearContents
  End With
  On Error GoTo 0
End Sub[/td]
[/tr]
[/table]