JSDJSD

Si subes tu archivo completo con datos ficticios se podría hacer algo interesante

Ok, lo miro

HHE PRUEBA (3) (1) (1).xlsm

Prueba y comenta

Fijándonos solamente en el textbox26 sería esto lo que necesitas ?

Prueba y comenta HHE PRUEBA (3) (1).xlsm

Me alegro

El archivo HHE PRUEBA (3).xlsm

Esta tarde lo comparto

A ver si es esto

El archivo HHE PRUEBA (1).xlsm

En formulario: Private Sub TextBox16_Change(): ContarTextBoxes: End Sub Private Sub TextBox17_Change(): ContarTextBoxes: End Sub Private Sub TextBox18_Change(): ContarTextBoxes: End Sub Private Sub TextBox19_Change(): ContarTextBoxes: End Sub Private Sub TextBox20_Change(): ContarTextBoxes: End Sub Private Sub TextBox21_Change(): ContarTextBoxes: End Sub Private Sub TextBox22_Change(): ContarTextBoxes: End Sub En módulo: Sub ContarTextBoxes() Dim Control As Control Dim contador As Integer Dim contador2 As Integer Dim i As Integer ' Inicializar contadores contador = 0 contador2 = 0 ' Recorrer los TextBox desde TextBox16 hasta TextBox22 For i = 16 To 22 Set Control = frmvtl.Controls("TextBox" & i) If Trim(Control.Value) <> "" Then ' Incrementar contador si hay datos contador = contador + 1 Control.BackColor = RGB(0, 255, 0) ' Verde si hay datos Else Control.BackColor = RGB(255, 255, 255) ' Blanco si no hay datos End If Next i ' Evaluar TextBox21 y TextBox22 para contador2 If Trim(frmvtl.Controls("TextBox21").Value) = "" Then contador2 = contador2 + 1 ' TextBox21 vacío End If If Trim(frmvtl.Controls("TextBox22").Value) = "" Then contador2 = contador2 + 1 ' TextBox22 vacío End If ' Mostrar resultados en los TextBox correspondientes frmvtl.Controls("TextBox25").Value = contador frmvtl.Controls("TextBox27").Value = contador frmvtl.Controls("TextBox28").Value = contador frmvtl.Controls("TextBox30").Value = contador2 ' Mostrar contador2 ActualizarTextBox End Sub Private Sub ActualizarTextBox() Dim rangoFechas As Range Dim fechaInicio As Date Dim fechaFin As Date Dim resultado As Long Dim i As Long Dim fechaActual As Date Dim mesActual As Long ' Define la hoja de trabajo With Sheets("USUARIOS & PRIVILEGIOS") ' Define el rango de fechas Set rangoFechas = .Range("BS27:BS56") ' Calcula el primer y último día del mes actual fechaInicio = WorksheetFunction.EoMonth(Date, -1) + 1 ' Primer día del mes actual fechaFin = WorksheetFunction.EoMonth(Date, 0) ' Último día del mes actual ' Inicializa el resultado resultado = 0 ' Obtiene el mes actual mesActual = Month(Date) ' Recorre las celdas para contar los días feriados del mes actual For i = 1 To rangoFechas.Rows.Count fechaActual = rangoFechas.Cells(i).Value ' Verifica si la fecha está dentro del mes actual If fechaActual >= fechaInicio And fechaActual <= fechaFin Then ' Cuenta el día si es un feriado (suponiendo que los feriados están en formato de fecha) resultado = resultado + 1 End If Next i End With ' Asigna el resultado al TextBox31 frmvtl.TextBox31.Value = resultado End Sub

Suponiendo que es esto lo que necesitas te dejo una posible solución

El propósito de tu formula que es saber los días feriados que se encuentran en la tabla correspondientes al mes actual?

Mañana te lo miro y lo comparto

sube archivo con datos en dichas columnas para hacer pruebas

Es esto lo que buscas ?

Sube tu archivo

Sube tu archivo y vemos lo que se puede hacer

Si te explicas mejor y pones un ejemplo visual de lo que quieres conseguir, lo intentamos.

Private Sub CommandButton1_Click() With Hoja8 ultimaFila = .Cells(.Rows.Count, "B").End(xlUp).Row For Each celda In .Range("B5:B" & ultimaFila) If Not IsEmpty(celda.Value) Then año = CInt(Mid(celda.Value, 1, 2)) mes = CInt(Mid(celda.Value, 3, 2)) día = CInt(Mid(celda.Value, 5, 2)) If año <= 21 Then año = año + 2000 Else año = año + 1900 End If On Error Resume Next fechaResultado = DateSerial(año, mes, día) If Err.Number <> 0 Then fechaResultado = "Fecha Inválida" Err.Clear End If On Error GoTo 0 celda.Offset(0, 1).Value = fechaResultado End If Next celda If IsDate(.Range("A2").Value) Then fechaReferencia = .Range("A2").Value Else MsgBox "La celda A2 no contiene una fecha válida.", vbExclamation Exit Sub End If For i = 5 To ultimaFila If IsDate(.Cells(i, "C").Value) Then .Cells(i, "K").Value = Year(fechaReferencia) - Year(.Cells(i, "C").Value) Else .Cells(i, "K").Value = "Fecha no válida" End If Next i End With End Sub Cumpleaños Foro.xlsm

Hola a ambos, te dejo otra posible solución

Busca el último valor en la columna A de Hoja2. Filtra los datos en Hoja1, comenzando en A4, para mostrar solo las filas donde los valores en la columna A son mayores que el valor encontrado en Hoja2. Copia las filas filtradas (excluyendo los encabezados) y las pega en Hoja2, comenzando justo debajo del último valor en la columna A. Elimina el filtro aplicado en Hoja1, dejando los datos visibles en su estado original. Este código es útil si estás trabajando con datos que necesitas transferir de Hoja1 a Hoja2, pero solo quieres copiar las nuevas filas que tienen un valor en la columna A mayor que el último valor en Hoja2.

Sub BorrarCobros() With Sheets("Hoja1") Set rango = .Range("A1").CurrentRegion rango.AutoFilter Field:=12, Criteria1:="COBRADA" .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row) _ .SpecialCells(xlCellTypeVisible).EntireRow.Delete .AutoFilterMode = False End With End Sub Esta sería la otra variante

Hola a todos, dejo otra más Sub BorrarCobros() With Hoja1 Set rango = .Range("A1").CurrentRegion rango.AutoFilter Field:=12, Criteria1:="COBRADA" .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row) _ .SpecialCells(xlCellTypeVisible).EntireRow.Delete .AutoFilterMode = False End With End Sub Suponiendo que los datos los tienes en la Hoja1 (nombre interno)