Macro contar celdas con formato

.

Buenos días, Jonathan

Estabas cerca. Solo que, al poner "Total" entre comillas, el mensaje (MsgBox)lo interpreta como un texto, no como una variable. Y faltó evaluar que la celda no contenga "Valor1"

Esta rutina hace ambas cosas:

Sub Totalarcolor()
'---- Variables modificables ----
'=== JONATHAN, modifica estos datos de acuerdo a tu proyecto:
    Elarea = "A1:A65000" ' area donde buscar celda con color
    ElColor = 13551615 'código de color a buscar
    Omitir = "Valor1" ' contenido de la celda que no deba contarse
'---- fin Variables
'
'---- inicio de rutina
'  
For Each Celda In Range(Elarea)
    If Celda.Interior.Color = ElColor And Celda.Value <> Omitir Then Total = Total + 1
Next Celda
ElMensaje = IIf(Total = 0, "NO SE EONCOTRO CELDA ALGUNA" & Chr(10) & "CON EL COLOR BUSCADO", "Se encontraron: " & Total & " celda" & IIf(Total > 1, "s", "") & Chr(10) & "con ese color.")
TipoMens = IIf(Total = 0, vbCritical, vbInformation)
ElTitulo = IIf(Total = 0, "SIN COINCIDENCIAS", "TERMINADO!")
Application.ScreenUpdating = True
MsgBox ElMensaje, TipoMens, ElTitulo
End Sub

Como modo de programación prefiero poner todo lo que pudiera cambiar en variables al inicio.

Verás que acoté el rango de búsqueda para agilizar la ejecución de la macro.

De todos modos, allí puedes escribir el rango que realmente quieras evaluar.

.

Hola me ayudó mucho la macro que me enviaste a ver algunas cosas en las que había fallado, te adjunto una nueva macro que logre armar, pero aun me faltan cosas dado que ya no funciona =(

Básicamente lo que necesito que haga es que de un rango, cuente las celdas con color y cuente las celdas con un texto, luego que reste para que me entregue el valor de todas las celdas que tienen color pero que no contienen la palabra RUT en la hoja 1, hoja 2, hoja 3 y hoja 4. y esto que se ejecute cada vez que abro el libro y cada vez que lo voy a cerrar. 

A medida que voy logrando los pasos le voy añadiendo otras dificultades, pero en el principio necesito que lo haga por lo menos con la hoja 1. 

Tomé el consejo de hacer más pequeño el rango de búsqueda, ya que se demoraba mucho. 

Esta es la macro que tengo hasta el momento. 

Sub contarcolor()

Dim TotalA As Integer
Dim TotalB As Integer
Dim TotalF As Integer
Dim UR As Long
Dim Elcolor As String
Dim Textobus As String

Textobus = "RUT"
Elcolor = 13551615

UR = [A1048576].End(xlUp).Offset(1, 0).Row
Range(Cells(1, 1), Cells(UR, 1)).Select

For Each Celda In Selection
If Celda.Interior.Color = Elcolor Then
TotalA = TotalA + 1
End If
If Celda.Value = Textobus Then
TotalB = TotalB + 1
End If
Next Celda

TotalA -TotalB = TotalF

If TotalF <= 0 Then
MsgBox ("Sin registros duplicados")
Else
MsgBox ("Existen" & TotalF & "registros duplicados")

End Sub

Espero que me puedas orientar. 

Muchas gracias!

.

Hola, Jonathan

Si es lo que realmente quieres, la rutina está ok, pero tiene un error en la carga de la variable TotalF

Donde dice:

TotalA -TotalB = TotalF

debe decir:

TotalF = TotalA -TotalB

Quedando la rutina así:

Sub contarcolor()
Dim TotalA As Integer
Dim TotalB As Integer
Dim TotalF As Integer
Dim UR As Long
Dim Elcolor As String
Dim Textobus As String
Textobus = "RUT"
Elcolor = 13551615
UR = [A1048576].End(xlUp).Offset(1, 0).Row
Range(Cells(1, 1), Cells(UR, 1)).Select
For Each Celda In Selection
If Celda.Interior.Color = Elcolor Then
    TotalA = TotalA + 1
End If
If Celda.Value = Textobus Then
    TotalB = TotalB + 1
End If
Next Celda
TotalF = TotalA - TotalB '<<<<< AQUI estaba invertido
If TotalF <= 0 Then
MsgBox ("Sin registros duplicados")
Else
MsgBox ("Existen" & TotalF & "registros duplicados")
End If
End Sub

Como está programado, TotalA guarda todas las celdas que tengan ese color, independientemente de que digan RUT en ellas o no.

Del mismo modo, TotalB, cuenta todas las que digan RUT, independientemente del color que tengan.

De acuerdo a como yo lo había interpretado antes, armaba un único contador que sólo se incrementara si tenía el color indicado y NO decía RUT en esa celda. Pero entiendo que puedes estar necesitándolo de la otra manera.

Para que funcione para las hojas indicadas y cada vez que abras o cierres el archivo debes ir al Editor de VBA (atajo: Alt + F11) y busca la hoja que dice "ThisWorkbook" (o "EsteLibro" según la versión").

Copia el código siguiente y pégalo en el panel desplegado a la derecha de su Editor de Visual Basic:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call contarcolor
End Sub
Private Sub Workbook_Open()
Call contarcolor
End Sub
Sub contarcolor()
Dim TotalA As Integer
Dim TotalB As Integer
Dim TotalF As Integer
Dim UR As Long
Dim Elcolor As String
Dim Textobus As String
Application.ScreenUpdating = False
Textobus = "RUT"
Elcolor = 13551615
EnHojas = Array("hoja 1", "hoja 2", "hoja 3", "hoja 4") ' lista de hojas a considerar
HojVue = ActiveSheet.Name
For Each Hoj In Sheets()
    For HojaAct = 0 To UBound(EnHojas)
        If UCase(Hoj.Name) = UCase(EnHojas(HojaAct)) Then
            Hoj.Select
            UR = [A1048576].End(xlUp).Offset(1, 0).Row
            Range(Cells(1, 1), Cells(UR, 1)).Select
            For Each Celda In Selection
                If Celda.Interior.Color = Elcolor Then
                    TotalA = TotalA + 1
                End If
                If Celda.Value = Textobus Then
                    TotalB = TotalB + 1
                End If
            Next Celda
        End If
    Next
Next
TotalF = TotalA - TotalB
If TotalF <= 0 Then
MsgBox ("Sin registros duplicados")
Else
MsgBox ("Existen" & TotalF & "registros duplicados")
End If
End Sub

Desde luego, al considerar las hojas indicadas TotalF acumula las coincidencias de todas ellas.

Bien, amigo, creo que con esto cubres todo lo que pedías. En tal caso, recuerda valorizar esta respuesta.

Muy buen fin de semana.

Fernando

.

. ----- Te quedó pendiente valorizar el tiempo que te dediqué----

Buenas,

Si hubieses tenido la oportunidad de probar la solución, espero que te haya ayudado a resolver tu problema.

Si así fuera, agradeceré un comentario y que la valorices para finalizarla.

Saludos!

Fernando

.

Muchas gracias !  De verdad que lamentó la demora, (me enfoqué en otro tema de salud personal) 

muchas gracias por tu tiempo y dedicación! 

Revisare La macro