Need assistance with my VBA code

[Giovanni03]

Hello everyone!

I have a vba code which i use to identify unique orders that are delivery only with no services. I'm looking to tweak it up so it doesn't find only unique delivery only orders.

example:

*Data starts in row 12*

Order Number (COLUMN A)

Fulfillment Type (COLUMN B)

1187858

DELIVERY

0145607	DELIVERY
0145607	DELIVERY

The code works the way I originally wanted it to but now I need to highlight all delivery only orders(Unique and duplicate). so the example above of order # 0145607 is what I'm looking to highlight BUT if the order includes "SERVICES" or "RETURN" in Column B then don't highlight (Example below)

0114890	DELIVERY
0114890	SERVICE (or RETURN)
0114890	DELIVERY

Sub countuniques_2()
  Dim c As Range
  Dim lr As Long
  Dim mess As String
  mess = ""
 
  Range("A12:B12").Interior.Color = xlNone
  lr = Range("A" & Rows.Count).End(3).Row
  For Each c In Range("A12:A" & lr)
    If WorksheetFunction.CountIf(Range("A12:A" & lr), c.Value) = 1 And _
      Range("B" & c.Row).Value = "DELIVERY" Then
      Range("A" & c.Row & ",B" & c.Row).Interior.Color = vbYellow
      Range("A" & c.Row & ",B" & c.Row).Font.Bold = True
      ct = ct + 1
        End If
    Next
If ct = 0 Then
        
    mess = "Delivery Only Order Found 0"

    End If
    
If ct >= 1 Then

    mess = "Delivery Only Order Found " & ct
    
    End If
    
    If mess <> "" Then MsgBox mess
    
End Sub

 

[DanteAmor]

Try this:

Sub countuniques_3()
  Dim c As Range, rng As Range
  Dim n As Long, m As Long, ct As Long
  Dim sStr As String
 
  Set rng = Range("A12", Range("A" & Rows.Count).End(3))
  With rng.Resize(rng.Rows.Count, 2)
    .Interior.Color = xlNone
    .Font.Bold = False
  End With
 
  For Each c In rng
    n = WorksheetFunction.CountIf(rng, c.Value)
    m = WorksheetFunction.CountIfs(rng, c.Value, rng.Offset(, 1), "DELIVERY")
    If n = m Then
      If InStr(1, sStr, c.Value) = 0 Then
        sStr = sStr & c.Value & vbCr
        ct = ct + 1
      End If
      With c.Resize(1, 2)
        .Interior.Color = vbYellow
        .Font.Bold = True
      End With
    End If
  Next

  MsgBox "Delivery Only Order Found " & ct & vbCr & sStr
End Sub

Note: If you don't want the orders in the msgbox, then delete this part: & vbCr & sStr

 

[Bosquedeguate]

try this code
change fr from 1 to 12

Option Explicit
Sub countuniques_2()
  Dim c As Range
  Dim fr As Long, lr As Long
  Dim mess As String
  Dim ct
  Dim x, y
 
 
  mess = ""
  ct = 0
  fr = 1 '12

  lr = Range("A" & Rows.Count).End(3).Row
 
  Range("A" & fr & ":B" & lr).Interior.Color = xlNone
 
  For Each c In Range("A" & fr & ":A" & lr)
    x = WorksheetFunction.CountIf(Range("A" & fr & ":A" & lr), c.Value)
    y = WorksheetFunction.CountIfs(Range("A" & fr & ":A" & lr), c.Value, Range("B" & fr & ":B" & lr), "DELIVERY")
    If x = y Then
      Range("A" & c.Row & ",B" & c.Row).Interior.Color = vbYellow
      Range("A" & c.Row & ",B" & c.Row).Font.Bold = True
      ct = ct + 1
    End If
  Next
       
    mess = "Delivery Only Order Found " & ct
   
    MsgBox mess
   
End Sub

 

[Giovanni03]

Thank you so much!!! Both Codes worked