Macro para ejecutar cuando hay Fecha en la cabecera de la columna

Para evaluar los títulos hay que mirar en qué se diferencian unas celdas de otras.

Aquí ya no es letra vs número, sino que depende del 'largo' del texto que contengan. Por lo que utilizaré la función LEN

Solo cambia la instrucción de control (If Not isNumeric...) por esta otra:

'a partir de aquí tu proceso de marcado.
  If Len(Cells(5, Target.Column)) > 4 Then

Si debe colorear las columnas de fechas,  se compara con  > 4      (1er ej. en la imagen)

Si debe colorear las columnas del año, se compara con = 4 (2do ej. en la imagen)

Buenas noches Elsa, por favor para aprender, esta base de datos comienza en A5 que línea debo modificar por ejemplo si comienza en A2.

¿Podrá ayudarme?

Saludos

En la macro de 'Extremos, donde dice 13 (luego 5) y ahora 2.

Y en ésta otra así:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call extremos
'-------------------
ini = ini + 6           'ajustar o realizar una búsqueda de la primera col a tildar
'-------------------
'si la celda seleccionada no está en el rango posible, cancela. AJUSTAR en otros modelos de hoja
If ActiveCell.Row < 3 Or ActiveCell.Column < ini Or ActiveCell.Column > fini Then Exit Sub
'si el título inicia con un número, es fecha y no se marca
  If Len(Cells(2, Target.column) > 4 Then       'fila 2
      If ActiveCell.Interior.ColorIndex < 0 Then
         ActiveCell.Interior.ColorIndex = 9       'asignar el nro de color a gusto
         ActiveCell.Offset(, 1) = "P"
      Else
        ActiveCell.Interior.ColorIndex = xlNone     'quita el color y el valor 
         ActiveCell.Offset(, 1) = ""
      End If
      Target.Select      'se vuelve a la celda seleccionada
   End If
End Sub

O sea, donde se hace mención a la fila 5 va 2. Y donde se analiza si ActiveCell.Row < 14 ( o sea si se trata de filas por encima de la 14 en la versión original) aquí va < 3 porque los títulos empiezan en fila 2.

Sdos!

¡Muchas Gracias!

Saludos, Juan Carlos

Elsa, buenas tardes creo que modifique lo que ud. pide pero sale error

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call extremos
'-------------------
ini = ini + 4 '6 ajustar o realizar una búsqueda de la primera col a tildar
'-------------------
'si la celda seleccionada no está en el rango posible, cancela
If ActiveCell.Row < 6 Or ActiveCell.Column < ini Or ActiveCell.Column > fini Then Exit Sub
'a partir de aquí tu proceso de marcado.
'If Not IsNumeric(Left(Cells(5, Target.Column), 1)) Then
If Len(fila(2, Target.Column)) > 3 Then 'Si debe colorear las columnas de fechas, se compara con > 4
'Si debe colorear las columnas del año, se compara con = 4
If ActiveCell.Interior.ColorIndex < 0 Then
'ActiveCell = "a"
ActiveCell.Interior.ColorIndex = 44 '9
ActiveCell.Offset(, 1) = "P"
Else
'ActiveCell = ""
ActiveCell.Interior.ColorIndex = xlNone
ActiveCell.Offset(, 1) = ""
End If
Target.Select
End If
End Sub

/////////////////////////////////////////////////////////

Public ini As Integer, fini As Integer '*** NO OLVIDAR ESTA LÍNEA ****
Sub extremos()
'primera columna
If [A2] <> "" Then
ini = 1
Else
ini = Range("A2").End(xlToRight).Column
End If
'ultima columna ocupada
fini = Range("S2").End(xlToLeft).Column
End Sub

Saludos,

Fijate cómo dejé escrita la instrucción allí donde te marca el error y cómo la dejaste en tu código:

If Len(Cells(2, Target.column) > 4 Then 

Sdos!

¡Muchas Gracias!, Feliz día el Lunes 01/05

Saludos

Para Elsa Matilde

Buenos días Elsa, por favor no puedo encontrar la vuelta a esta macro me confundo cuando debo modificarla y adaptarla al cambio de columna y fila de inicio podría ud. ayudarme

Public ini As Integer, fini As Integer '*** NO OLVIDAR ESTA LÍNEA ****
Sub extremos()
'primera columna
If [D12] <> "" Then
ini = 1
Else
ini = Range("D12").End(xlToRight).Column
End If
'ultima columna ocupada
fini = Range("T12").End(xlToLeft).Column
End Sub

//////////////////////////////////////////////////////////

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call extremos
'-------------------
ini = ini + 13 '6 ajustar o realizar una búsqueda de la primera col a tildar
'-------------------
'si la celda seleccionada no está en el rango posible, cancela
If ActiveCell.Row < 12 Or ActiveCell.Column < ini Or ActiveCell.Column > fini Then Exit Sub
'a partir de aquí tu proceso de marcado.
'If Not IsNumeric(Left(Cells(5, Target.Column), 1)) Then
If Len(Cells(12, Target.Column)) > 12 Then 'Si debe colorear las columnas de fechas, se compara con > 4
'Si debe colorear las columnas del año, se compara con = 4
If ActiveCell.Interior.ColorIndex < 0 Then
'ActiveCell = "a"
ActiveCell.Interior.ColorIndex = 44 '9
ActiveCell.Offset(, 1) = "P"
Else
'ActiveCell = ""
ActiveCell.Interior.ColorIndex = xlNone
ActiveCell.Offset(, 1) = ""
End If
Target.Select
End If
End Sub