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

 

[Brew]

Yes, that is it...Thank you.....I have another code that operate the same way for red combos. How do i update this code to eliminate if the combination has any duplicates. thanks
This one only delete the Red Combos when 2 number within the combos are the same and not all different:
example: 006, 606 [DELETE], 312 [NO ACTION]

Sub DeleteRedCombos()
Dim Cnt As Integer, LastRow As Integer
LastRow = Sheets("sheet5").Cells(Rows.Count, "C").End(xlUp).Row
Do While Cnt <= LastRow
Cnt = Cnt + 1
If Sheets("sheet5").Cells(Cnt, "C").Interior.ColorIndex = 3 _
And Sheets("sheet5").Cells(Cnt, "D").Interior.ColorIndex = 3 _
And Sheets("sheet5").Cells(Cnt, "E").Interior.ColorIndex = 3 Then
If Sheets("sheet5").Cells(Cnt, "C") <> Sheets("sheet5").Cells(Cnt, "D") _
And Sheets("sheet5").Cells(Cnt, "C") <> Sheets("sheet5").Cells(Cnt, "E") _
And Sheets("sheet5").Cells(Cnt, "D") <> Sheets("sheet5").Cells(Cnt, "E") Then
With Sheets("Sheet5")
.Cells(Cnt, "C").ClearContents
.Cells(Cnt, "D").ClearContents
.Cells(Cnt, "E").ClearContents
End With
End If
End If
Loop
End Sub
[/code]

 

[jindon]

dk
Change <> To = and And To Or in the 2nd If clause.

 

[Brew]

Thanks, I made the updates as shown below, however I got a subscript out of range error for line 3:
LastRow = Sheets("sheet8").Cells(Rows.Count, "C").End(xlUp).Row

Sub DeleteRedComboDoubles()
Dim Cnt As Integer, LastRow As Integer
LastRow = Sheets("sheet8").Cells(Rows.Count, "C").End(xlUp).Row
Do While Cnt <= LastRow
Cnt = Cnt + 1
If Sheets("sheet8").Cells(Cnt, "C").Interior.ColorIndex = 3 _
And Sheets("sheet8").Cells(Cnt, "D").Interior.ColorIndex = 3 _
And Sheets("sheet8").Cells(Cnt, "E").Interior.ColorIndex = 3 Then
If Sheets("sheet8").Cells(Cnt, "C") = Sheets("sheet8").Cells(Cnt, "D") _
Or Sheets("sheet8").Cells(Cnt, "C") = Sheets("sheet8").Cells(Cnt, "E") _
Or Sheets("sheet8").Cells(Cnt, "D") = Sheets("sheet8").Cells(Cnt, "E") Then
With Sheets("Sheet8")
    .Cells(Cnt, "C").ClearContents
    .Cells(Cnt, "D").ClearContents
    .Cells(Cnt, "E").ClearContents
End With
End If
End If
Loop
End Sub

[/code]

 

[jindon]

The only thing I can guess is wrong sheet name...

 

[Brew]

Yep, that worked...Thanks a bunch