Problema con macro al modificarla

Hola, muy buenos días, bien explico el problema que me trae aquí: tengo una macro que realiza una búsqueda de cada dato (de una lista de datos ubicada en una de las hojas) en todas las filas de las hojas, al ubicarlo verifica que este dato cumpla con una condición en otra columna de su fila correspondiente, si no se cumple, colorea la fila. Ahora bien, agregué un nuevo módulo, copie el código de la macro y modifique para que haga lo mismo con otra lista de datos y con una condición diferente, (es decir ahora tendría dos macros que trabajen sobre el mismo libro) agregue una hoja con una nueva lista de datos( la renombre "List"), y en la macro, cambio el nombre de la hoja <Set h1 = Sheets("List")> y en la condición <If h.Cells(b.Row, "F") <>2 Then > solo le cambio el valor por <>1, pero no me funciona! No hace nada! Por más que le busco no encuentro el motivo :( , ojalá pudieran ayudarme..

1 Respuesta

Respuesta
1

Puedes poner la macro completa

Hola, de hecho tú mismo (sino me equivoco) me habías ayudado con esa macro la cual funciona de maravilla, pero ahora necesito que evalúe a otro conjunto de datos (dentro del mismo libro) con una condición diferente y por lo tanto coloree la fila en otro color (38) si no se cumpliera la condición (<>1). Te pongo la macro:

Sub evaluar()
'Por.DAM
Set h1 = Sheets("Nombres")
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
For Each h In Sheets
Select Case h.Name
'hojas que no se van a evaluar
Case "Nombres", "Sheet2", "Sheet3"
Case Else
Set r = h.Columns("E")
Set b = r.Find(h1.Cells(i, "A"), lookat:=xlPart)
If Not b Is Nothing Then
ncell = b.Address
Do
If h.Cells(b.Row, "F") <> 2 Then
h.Rows(b.Row).Interior.ColorIndex = 33
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> ncell
End If
End Select
Next
Next
End Sub

Si, efectivamente yo la hice, pero es más rápido si me pones la macro, porque luego las borro. En fin, ya la probé y si me funciona.

Sub evaluar()
'Por.DAM
Set h1 = Sheets("list")
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
    For Each h In Sheets
        Select Case h.Name
            'hojas que no se van a evaluar
            Case "list", "Sheet2", "Sheet3"
            Case Else
                Set r = h.Columns("E")
                Set b = r.Find(h1.Cells(i, "A"), lookat:=xlPart)
                If Not b Is Nothing Then
                    ncell = b.Address
                    Do
                        If h.Cells(b.Row, "F") <> 1 Then
                            h.Rows(b.Row).Interior.ColorIndex = 38
                        End If
                        Set b = r.FindNext(b)
                    Loop While Not b Is Nothing And b.Address <> ncell
                End If
        End Select
    Next
Next
End Sub

Prueba y me comentas
Saludos. Dante Amor
Si es lo que necesitas.

Mira, en esta liga esta el archivo con el cual estoy trabajando y las macros, de las cuales solo sigue funcionando una (la macro con el azul) :( estaré haciendo algo mal al ejecutarlo?

https://www.dropbox.com/s/wrgm3zv1sfhg5u1/Checadas%204%2C5%20Feb%202014%282%29.xlsm

Desde ya, muchas gracias!

No encuentra ninguno de los nombres, porque los nombres en tu hoja "list" tienen espacios del lado derecho, ve a tu hoja "list", selecciona un nombre, presiona F2 y verás como el cursor está adelante del nombre, esos son espacios.

O corriges cada uno de los nombre, o cambias en la macro esta línea:

Set b = r.Find(h1.Cells(i, "A"), lookat:=xlPart)

Por esta:

Set b = r.Find(RTrim(h1.Cells(i, "A")), lookat:=xlPart)

Te recomiendo que cambies los nombres.

Saludos. Dante Amor
No olvides finalizar la pregunta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas