Resaltar duplicados con colores iguales

[Potter08]

Hola, he visto por todo el foro pero nada se compara con lo que necesito.

Necesito que con una macro me resalte los textos duplicados de una columna X, ejemplo

si tengo en A1:A10 estos valores

Casa

Carro

Casa

Carro

Monitor

Tasa

Plato

Celda sin valor o sea en blanco

Carro

Tasa

tengo la siguiente macro, que me funciona si tengo solo 2 valores repetidos pero no me funciona para mas, como podria modificarla. y a la ves que no tomara en cuenta los colores Blanco y Negro.

Bueno adjunto ejemplo, para mejor entendimiento y ver funcionamiento de macro.

Salu2.xlsx

Ejemplo Duplicados.xls

[joshua]

Saludos.

Prueba con la siguiente macro el unico requisito ya que se utiliza autofiltro es tener un encabezado, espero te sea de utilidad.

Sub filtrar_y_colorear_repetidos()

Dim color As Byte, i, ii, contador, colores As Integer

Dim unicos, unico

On Error Resume Next

Application.ScreenUpdating = False

With Sheets("Hoja2")

    .Range("E6").Select

        For i = 6 To 15

            unicos = unicos & "," & .Cells(i, 5)

        Next i

    unico = Split(unicos, ",")

        For ii = 0 To UBound(unico)

            color = Int(Rnd * 55) + ii

            If color = 28 Then color = color + 5

            .Range("E5:E15").AutoFilter Field:=1, Criteria1:=unico(ii)

            contador = Application.Subtotal(3, .Range("E6:E15"))

            If InStr(colores, color) = 0 Then

                If contador > 1 Then

                    .Range("E6:E15").SpecialCells(xlCellTypeVisible) _

                    .Interior.ColorIndex = color

                End If

            End If

        Next ii

    .Range("E5:E15").AutoFilter

End With

Application.ScreenUpdating = True

End Sub[/CODE]

Atte.

joshua

[Invitado Gengis Khan]

Hola Sres.:

Otra forma de hacer lo mismo.

Válido para cualquier número de filas.

No es necesaria la fila de encabezamiento.

No recomendable para mas de 1.000 filas.

Sub Colorear()

Application.ScreenUpdating = False

Fila = 6: Columna = "E" [COLOR=#008000][B]'Sustituir a conveniencia[/B][/COLOR]

For x1 = Fila To Range(Columna & Rows.Count).End(xlUp).Row - 1

   For x2 = x1 + 1 To Range(Columna & Rows.Count).End(xlUp).Row

      If Range(Columna & x2) = Range(Columna & x1) Then

         If Not (Range(Columna & x1).Interior.ColorIndex = xlNone Or _

                 Range(Columna & x1).Interior.Color = vbWhite Or _

                 Range(Columna & x1).Interior.Color = vbBlack) Then

            Range(Columna & x2).Interior.Color = Range(Columna & x1).Interior.Color

         End If

      End If

   Next

Next

End Sub

Application.ScreenUpdating = True

[/CODE]

Saludos

[Potter08]

Muy buenos aportes, los rebiso y luego posteo si llego a solucionarlo.

Gracias !!!

salu2.xlsx

[Potter08]

Hola, de nuevo he probado ambas macros y una me funciona y otra no, a primera vista me pareció para simple la de Gengis Khan pero no me funciona no pone color a ninguna celda, según el archivo que adjunte, luego probé la macro de joshua y si funciona usando los filtros, me parece que por el momento voy a usar la de joshua si alguien sabe por que no funciona la macro de Khan favor corregirla, gracias a ambos por sus aporte, espero sus comentarios, salu2.xlsx. :glee: