Resaltar con color fecha que se encuentra entre un rango (desde hasta)

Para elsa

Quiero resaltar fecha con color que se encuentra entre un rango

Tengo este codigo pero no me resulta

Private Sub venci()
Dim fec1 As Date, fec2 As Date
Application.ScreenUpdating = False
Set hs = Sheets("medicamentos")
'

'
fec1 = Range("f1").Value ' aqui se encuentra la fecha de partida con formula =HOY()
fec2 = Range("g1").Value ' aqui la fecha final con formula =FECHA.MES(F1,24), el 24 son meses
hs = Array("Medicamentos")
'
For h = LBound(hs) To UBound(hs)
Hoja = hs(h)
For i = 3 To Sheets(Hoja).Range("A" & Rows.Count).End(xlUp).Row
For j = Sheets(Hoja).Columns("D").Column To Sheets(Hoja).Columns("D").Column Step 2
If Sheets(Hoja).Cells(i, j) >= fec1 And Sheets(Hoja).Cells(i, j) <= fec2 Then
u = Range("A" & Rows.Count).End(xlUp).Row + 1
hs.Cells(u, j).Interior.ColorIndex = 4
'Application.ScreenUpdating = True
End If
Next
Next
'Application.ScreenUpdating = True
Next

End Sub

Lo unico que quiero es colorear las fechas que estan en ese rango.

1 Respuesta

Respuesta
2

Si lo único que quieres es colorear las fechas que están en ese rango, entiendo que serán todas aquellas filas cuya col D esté en ese rango ... o a lo sumo solo las celdas de la col D.

Si es así, el código es bastante más simple. Solo deja una de las 2 instrucciones de color. Por ahora quedó habilitada la que colorea la fila completa:

Private Sub venci()
'x Elsamatilde
Dim fec1 As Date, fec2 As Date
Application.ScreenUpdating = False
'solo se aplicará a la hoja Medicamentos
Set hs = Sheets("medicamentos")
'
fec1 = Range("f1").Value ' aqui se encuentra la fecha de partida con formula =HOY()
fec2 = Range("g1").Value ' aqui la fecha final con formula =FECHA.MES(F1,24), el 24 son meses
'los datos empiezan en fila 3 y se recorre el total de registros
For i = 3 To hs.Range("A" & Rows.Count).End(xlUp).Row
'se controla fechas en col D
If hs.Cells(i, "D") >= fec1 And hs.Cells(i, "D") <= fec2 Then
    'hs.Cells(i, 4).Interior.ColorIndex = 4   'solo se colorea la celda de la col D
    hs.Cells(i, 4).EntireRow.Interior.ColorIndex = 4   'se colore toda la fila
End If
Next
End Sub

gracias, funciona

pero que tendria que cambiar para que me funcione para cinco hojas

ahora solo funciona para la hoja "Medicamentos"

que codigo cambiaria para que al seleccionar cualquiera de las cinco hojas me funcione el codigo

para no tener que copiar el codigo cinco veces o sea uno para cada hoja.

Si la necesitas para la 'hoja activa', es decir que estando ya en la hoja o habiéndola activado previamente mediante otra macro, entonces solo hay que cambiar la instrucción del Set hs por esta otra:

Private Sub venci()
'x Elsamatilde
Dim fec1 As Date, fec2 As Date
Application.ScreenUpdating = False
'solo se aplicará a la hoja activa
Set hs = Sheets(ActiveSheet.Name)

Si no se trata de este caso aclara un poco cómo llamarás a esta subrutina o cómo le indicarás en qué hoja trabajar o si debe marcar en varias hojas al mismo tiempo (utilizaría en ese caso el Array original).

Sdos!

hola

como hago para que no me coloree celdas vacias

Ya encontré el origen de ese problema, gracias

quiero pedirle algo mas con esta macro pero creo que eso seria otra pregunta

asi que voy formularla y la molesto con su ayuda.

gracias

Entiendo que lo de las celdas vacías lo resolviste, sino aclara si debe ser mirado todo el rango (A:J) para detectar si está vacía o no.

Si el tema quedó resuelto no olvides valorar la respuesta. Ya te envié instrucciones en la nueva consulta.

Sdos!

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas