Macro muestra mensaje informativo

Buenos días gente!, tengo la siguiente macro donde elimina celdas con datos repetidos (en el caso de que haya) en una columna determinada. Lo que necesito es que ademas me informe la cantidad de datos repetidos que encontró (algo así como "Se encontraron 3 registros repetidos")
El código es el siguiente
Sub EliminarValoresRepetidos()
contador = 0
Dim fila As Long
With Application
For fila = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If .WorksheetFunction.CountIf(Range("A:A"), _
Cells(fila, 1)) > 1 Then Cells(fila, 1).EntireRow.Delete
Next fila
End With
End Sub
Saludos!
Respuesta
1
Podría servirte esta:
Sub EliminarValoresRepetidos()
Dim fila As Long
Dim contador As Long
contador = 0
With Application
For fila = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If .WorksheetFunction.CountIf(Range("A:A"), Cells(fila, 1)) > 1 Then
Cells(fila, 1).EntireRow.Delete
contador = contador + 1
End If
Next fila
End With
MsgBox "Se encontraron " & contador & " registros repetidos", vbInformation
Muchas gracias amigo, incorpore los códigos y lo pude aplicar pero tuve que mover el "End If" de lugar y colocarlo debajo de "End with" para que funcione.
Pero lo malo es que aun así no funciona correctamente. Me devuelve que se han repetido 11 valores cuando solo hay 1 solo valor repetido.
A continuación paso la macro de como esta actualmente ya que tiene ademas algunas otras modificaciones de la version que coloque anteriormente (lo que esta en negrita es donde tengo el problema):
Sub tipo_de_contratos()
If MsgBox("Se actualizara el Registro de contratos ¿Continuar?", vbQuestion + vbYesNo) = vbYes Then
Sheets("REGISTRO").Select
Dim miFila As Integer
miFila = ActiveSheet.Range("B65500").End(xlUp).Row + 1
' busca dato en primera hoja y lo copia
Sheets("DATOS PERSONALES").Select
Range("B10:B2000").Select
Selection.Copy
Range("A08").Select
' vuelve a la hoja y lo pega como "solo valores" en la ultima celda vacia
Sheets("REGISTRO").Select
Cells(miFila, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' eliminar datos repetidos
Dim fila As Long
Dim contador As Long
contador = 0
With Application
For fila = Cells(Rows.Count, 2).End(xlUp).Row To 1 Step -1
If .WorksheetFunction.CountIf(Range("B:B"), _
Cells(fila, 2)) > 1 Then Cells(fila, 2).EntireRow.Delete
contador = contador + 1
Next fila
End With
End If
MsgBox "Se encontraron " & contador & " registros repetidos", vbInformation
Range("B8").Select
Hoja6.Activate
Es correcto, si mueves el End If no te cuenta bien.
Para que te cuente solo las filas que se borran no debes mover el End If.
Prueba sin mover el End If y me dices.
Ah! y acuerdaté de cerrar tu If, que creo que ese puede ser el problema.
tu If es este:
If MsgBox("Se actualizara el Registro de contratos ¿Continuar?", vbQuestion + vbYesNo) = vbYes
Me dices ;)
Antes que nada gracias por prestar tu tiempo para responder mis consultas, ya probé volviendo a colocar el end if donde lo pusiste pero me dice que falta un "IF para el End If". Probé poniéndole "End If" donde faltaba pero aun así salta el mismo error.
Si quito el "End If" no marca error pero me devuelve la leyenda "16 valores repetidos" y eso es erróneo, pero pienso que el problema puede llegar a ser otro. Te mando un cap!
Ok, entiendo.
Lo que debes hacer es esto:

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas