(VBA) How can I remove duplicates but exclude rows with a specific value in a column?

[moddddmyexcel]

My current code is below. The problem is in column 9 I have over 2000 possible different values but I do not want to remove duplicates for rows that contain "VNASTG" in column 9.

Sheets("Data").Range("A4:I300000").RemoveDuplicates Columns:=Array(1, 2, 9), Header:= _
xlYes

 

[moddddmyexcel]

This small change should do it I think.

Sub RemoveDupesWithException_v2()
  With Sheets("Data")
    With .Range("A4", .Range("I" & Rows.Count).End(xlUp))
      .Columns(9).Value = .Worksheet.Evaluate(Replace("if(left(#,3)=""VNA"",[B]#&""||""&ROW(#)[/B],#)", "#", .Columns(9).Address))
      .RemoveDuplicates Columns:=Array(1, 2, 9), Header:=xlYes
      .Columns(9).Replace [B]What:="||*", Replacement:=""[/B], LookAt:=xlPart
    End With
  End With
End Sub

I did not notice the data retention before. I see it now, this solution was crafty!

 

[Peter_SSs]

Very perspicacious solution Peter

Thanks .. I think. Too big a word for me.

I did not notice the data retention before. I see it now, this solution was crafty!

Glad it seems to have worked for you.

 

[DanteAmor]

Works great! How would I possibly add multiple criteria to this? Say there are additional locations I want to exclude as well like a VNASTG2.

Try using "Like"

Sub RemoveDuplicatesExcep()
  Dim dic As Object
  Dim a As Variant, b As Variant, ky As Variant
  Dim i&, j&, k&
 
  a = Range("A5", Range("I" & Rows.Count).End(3)).Value2
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
  Set dic = CreateObject("Scripting.Dictionary")
 
  For i = 1 To UBound(a, 1)
    ky = a(i, 1) & "|" & a(i, 2) & "|" & a(i, 9)
    If a(i, 9) Like "VNA*" Or Not dic.exists(ky) Then
        dic(ky) = Empty
        k = k + 1
        For j = 1 To UBound(a, 2)
          b(k, j) = a(i, j)
        Next
    End If
  Next
 
  Range("A5").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor