Updating Code1

[Brew]

Hello, how do I update the following code:

This one only delete the Yellow Combos when 2 number within the combos are the same and not all different:
example: 006, 606 [DELETE], 312 [NO ACTION]

Sub DeleteYellowCombos()
 For i = 5 To 804
  If Cells(i, "C") <> Cells(i, "D") And Cells(i, "C") <> Cells(i, "E") And Cells(i, "D") <> Cells(i, "E") Then
    If Abs(Cells(i, "C").Interior.ColorIndex = 6) + Abs(Cells(i, "D").Interior.ColorIndex = 6) + Abs(Cells(i, "E").Interior.ColorIndex = 6) > 1 Then
      Cells(i, "C").Resize(, 3).ClearContents
    End If
  End If
 Next i
End Sub

 

[jindon]

Do you mean, if all the cells have duplicate number, delete?

 

[Brew]

Yes exactly, Also, only 2 of the 3 numbers in the combo will have a yellow background.

 

[jindon]

See if this works

Sub DeleteYellowCombos()
Dim i As Long, ii As Long, dic As Object, a() As Integer, mItem As Object, m As Object
Set dic = createObject("Scripting.Dictionary")
ReDim a(2)
 For i = 5 To 804
  If Cells(i, "C") <> Cells(i, "D") And Cells(i, "C") <> Cells(i, "E") And Cells(i, "D") <> Cells(i, "E") Then
    If Abs(Cells(i, "C").Interior.ColorIndex = 6) + Abs(Cells(i, "D").Interior.ColorIndex = 6) + Abs(Cells(i, "E").Interior.ColorIndex = 6) > 1 Then
       For ii = 3 To 5
       With CreateObject("VBScript.RegExp")
             .Pattern = "\d"
             .Global = True
             Set mItem = .execute(Cells(i,ii).Text)
                 For Each m In mItem
                     If Not dic.exists(m.Value) Then
                         dic.Add m.Value, Nothing
                     Else
                         a(ii-3) = 1
                     End If
                 Next
        End With
        dic.removeall
        Next
        msgbox join(a,",")
        If Application.Sum(a) = 3 Then Cells(i, "C").Resize(, 3).ClearContents
        ReDim a(2)
    End If
  End If
 Next i
End Sub

 

[Brew]

There are no errors, however, it did not delete duplicate entries associated with yellow background.

 

[jindon]

dk

Can you fo the following for me?

1) copy the code again (I just added 1 msgbox)
2) type in 

      C5       D5      E5
     112      223     335
    and delete other data
3) Then run the code

Then can you come back with the msgbox?

 

[Brew]

I copy the code again from the edited version, but I dont understand step 2, what do you want me to do there

 

[jindon]

I want you to type in each cell
c5 : 112, d5:223 e5:335
just a dummy record to test
and also color the cell in yellow

 

[Brew]

my records have only one digit in each cell, so using your example, i could have c5:e5=112, c6:e6=223 and c7:e7=335. Is that what you want me to do or do we need to update the code again

 

[jindon]

my records have only one digit in each cell, so using your example, i could have c5:e5=112, c6:e6=223 and c7:e7=335. Is that what you want me to do or do we need to update the code again

Ah, now I understand..

I thought each cell has like 112,223,334 etc...

 

[jindon]

like this?

Sub DeleteYellowCombos()
 For i = 5 To 804
  If Cells(i, "C") = Cells(i, "D") Or Cells(i, "C") = Cells(i, "E") Or Cells(i, "D") = Cells(i, "E") Then
    If Abs(Cells(i, "C").Interior.ColorIndex = 6) + Abs(Cells(i, "D").Interior.ColorIndex = 6) + Abs(Cells(i, "E").Interior.ColorIndex = 6) > 1 Then
      Cells(i, "C").Resize(, 3).ClearContents
    End If
  End If
 Next i
End Sub