Elimina valores duplicados

Hola a todos nuevamente. Tengo el siguiente código que encontré por ahí, cuya función es la de buscar y eliminar valores repetidos en un rango determinado. Quisiera si fuaran tan amables, me pasaran la corrección que habría que hacer para lograr 2 variantes:
1. Que en lugar de eliminar solo la celda con el valor repetido elimine toda la fila o un rango de la fila.
2. Que en lugar de eliminar la celda la marque con un color X
El código es el siguiente:
Sub DelDups_OneList()
Dim iListCount As Integer
Dim iCtr As Integer
Application.ScreenUpdating = False
iListCount = Sheets("hoja1").Range("A1:A100").Rows.Count
Sheets("hoja1").Range("A1").Select
Do Until ActiveCell = ""
For iCtr = 1 To iListCount
If ActiveCell.Row <> Sheets("hoja1").Cells(iCtr, 1).Row Then
If ActiveCell.Value = Sheets("hoja1").Cells(iCtr, 1).Value Then
Sheets("hoja1").Cells(iCtr, 1).Delete xlShiftUp
iCtr = iCtr + 1
End If
End If
Next iCtr
ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
MsgBox "Done Dude!"
End Sub
Desde ya muchas gracias!

1 respuesta

Respuesta
1
La modificación para el color:
Sub DelDups_OneList()
Dim iListCount As Integer
Dim iCtr As Integer
Application.ScreenUpdating = False
iListCount = Sheets("hoja1").Range("A1:A100").Rows.Count
Sheets("hoja1").Range("A1").Select
Do Until ActiveCell = ""
For iCtr = 1 To iListCount
If ActiveCell.Row <> Sheets("hoja1").Cells(iCtr, 1).Row Then
If ActiveCell.Value = Sheets("hoja1").Cells(iCtr, 1).Value Then
Sheets("hoja1").Cells(iCtr, 1).Interior.ColorIndex = 6
Sheets("hoja1").Cells(iCtr, 1).Interior.Pattern = xlSolid
iCtr = iCtr + 1
End If
End If
Next iCtr
ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
MsgBox "Done Dude!"
End Sub
Modificacion para eliminar filas.
Sub DelDups_OneList()
Dim iListCount As Integer
Dim iCtr As Integer, aux As String
Application.ScreenUpdating = False
iListCount = Sheets("hoja1").Range("A1:A100").Rows.Count
Sheets("hoja1").Range("A1").Select
Do Until ActiveCell = ""
For iCtr = 1 To iListCount
If ActiveCell.Row <> Sheets("hoja1").Cells(iCtr, 1).Row Then
If ActiveCell.Value = Sheets("hoja1").Cells(iCtr, 1).Value Then
aux = iCtr & ":" & iCtr
Rows(aux).Select
Selection.Delete Shift:=xlUp
iCtr = iCtr + 1
End If
End If
Next iCtr
ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
MsgBox "Done Dude!"
End Sub
Muchas gracias. Funcionan tal lo pedí, sin embargo en la opción que marca con color, al ser una macro que se repite, los valores que están duplicados los marca todos ( en el caso que los elimine ya no los encuentra ). ¿Será posible que si detecta que la celda esta coloreada ya no busque ese dato?. De cualquier manera ya me ha sido de gran utilidad.
Saludos a todos
Haber si entiendo lo que necesitas:
             A B C
1 50
2 60
3 50
4 80
5 50
6 70
La Macro busca el valor de A1 = 50, lo encuentra en A3 y en A5
si lo que necesitas es que cuendo encuentre el A3 no siga buscando A1
Sub DelDups_OneList()
Dim iListCount As Integer
Dim iCtr As Integer
Application.ScreenUpdating = False
iListCount = Sheets("hoja1").Range("A1:A100").Rows.Count
Sheets("hoja1").Range("A1").Select
Do Until ActiveCell = ""
For iCtr = 1 To iListCount
If ActiveCell.Row <> Sheets("hoja1").Cells(iCtr, 1).Row Then
If ActiveCell.Value = Sheets("hoja1").Cells(iCtr, 1).Value Then
Sheets("hoja1").Cells(iCtr, 1).Interior.ColorIndex = 6
Sheets("hoja1").Cells(iCtr, 1).Interior.Pattern = xlSolid
iCtr = iCtr + 1
GoTo salir:
End If
End If
Next iCtr
salir:
ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
MsgBox "Done Dude!"
End Sub
No se si hay algo mal en el código o lo que yo necesito es muy complicado, pero es básicamente es lo que tu me planteas en el ejemplo, pero si a ese mismo ejemplo le agrego otro 50 en la fila 7 hay 2 que me quedan sin marcar. En algunas ocasiones pareciera que funciona correctamente y en otras no. Te vuelvo a aclarar cual es mi idea, buscar todos los datos repetidos (todos menos 1 que sería el dato primitivo) en un cierto rango y que me los marque de alguna menera para poder ver si los tengo que, por ejemplo, eliminar.
Nuevamente garcías, siguen siendo de gran ayuda las correcciones que has hecho.
Haber si ahora esta bien:
Sub Color()
Dim iListCount As Integer
Dim iCtr As Integer
Application.ScreenUpdating = False
iListCount = Sheets("hoja1").Range("A65536").End(xlUp).Row
Sheets("hoja1").Range("A1").Select
h = 1
Do Until ActiveCell = ""
For x = 1 To iListCount
For iCtr = h To iListCount
If ActiveCell.Row <> Sheets("hoja1").Cells(iCtr, 1).Row Then
If ActiveCell.Value = Sheets("hoja1").Cells(iCtr, 1).Value Then
Sheets("hoja1").Cells(iCtr, 1).Interior.ColorIndex = 6
Sheets("hoja1").Cells(iCtr, 1).Interior.Pattern = xlSolid
iCtr = iCtr + 1
End If
End If
Next iCtr
ActiveCell.Offset(1, 0).Select
h = h + 1
Next x
Loop
Application.ScreenUpdating = True
MsgBox "Done Dude!"
End Sub
Sub eliminar()
Dim iListCount As Integer
Dim iCtr As Integer, aux As String
Application.ScreenUpdating = False
iListCount = Sheets("hoja1").Range("A65536").End(xlUp).Row
Sheets("hoja1").Range("A1").Select
For iCtr = 1 To iListCount
If Sheets("hoja1").Cells(iCtr, 1).Interior.ColorIndex = 6 Then
aux = iCtr & ":" & iCtr
Rows(aux).Select
Selection.Delete Shift:=xlUp
iCtr = iCtr - 1
End If
Next iCtr
Application.ScreenUpdating = True
MsgBox "Done Dude!"
End Sub
Con la macro color coloreamos todos los datos repetidos menos el primitivo.
Con la macro eliminar, eliminamos todos aquellas celdas que estén con color.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Buenas tardes como están... Tengo una macro que compara diferencias entre 2 hojas

La macro compara las diferencias entre las 2 hojas y copia las diferencia en una tercera. Y trabaja bien con 30 o 40 lineas pero necesito que compare unas 900 o 1000 lineas, Otra cosa esta macro tiene una hoja ( hoja 1 como master) y importa datos de...
1 respuesta

¿Cómo sumar 2 label y 2 textbox,y mostrar suma en un 3er label?

Estoy haciendo un formulario en excel 2007, con un combobox que filtra, dos label que muestra datos del filtro, y dos text box, en la cual agrego o resto. Tanto en los dos labels como en los dos textbox se maneja con números. Cómo hacer que en un...
1 respuesta

Hacer una búsqueda en una hoja especifica de un libro excel

Quisiera saber como puedo modificar parte de una macro para que realice la búsqueda en una sola hoja por ejemplo hoja datos, y no en todo el libro. O bien ingresar la hoja a buscar mediante un inputBox. Sub ejemplo() Sheets("buscador").Select Dim...
1 respuesta

¿Cómo puedo ocultar COLUMNAS con macros en excel?

Tengo valores desde A1 a K18, son números, en A20 a K20 tengo una suma de todos los números, pero en algunos tengo valor CERO, lo que necesito es que si un valor de los que tengo en A20:K20 es igual a CERO oculte toda esa columna, por ejemplo: si en...
1 respuesta

Utilizar Find en macros o procedimiento similar

Necesitaría que me ayudarais a buscar los distintos nombres de una persona, copiar toda la fila donde aparece, pegarla en otra hoja. Esto con cada nombre que se encuentre igual al indicado por nosotros. Yo lo que he intentado son dos formas pero...
1 respuesta

Macro excel copia datos

Necesito una macro de excel que permita copiar celdas con contenido (es un arbol genealogico que tiene mas de cien nombres de personas) en otra hoja pero en columna. Los datos en la hoja del arbol genealogico estan dispersos, con celdas vacias...
1 respuesta

ComboBox y ListBox en excel

No se si estaré bien ubicado con mi pregunta. Tengo este código que un experto ya trató de ayudarme. A pesar de su voluntad y ganas de ayuda, no fue posible llegar a un termino positivo y el experto tuvo que descartar mi pregunta. Código Private Sub...
1 respuesta

Ocultar filas con celdas vacías

No he programado en mi vida una Macro, así que os cuento lo que necesito y lo que he utilizado "de oídas" buscando por internet. Tengo un Libro con distintas Hojas vinculadas y en una de ellas quiero ocultar las filas (desde la 52 hasta la 71) en las...
2 respuestas