Encontrar la fecha más cercana desde un textbox en una tabla de excel

Quiero solicitar su ayuda con un problema que tengo con una macro para extraer un reporte de una tabla de excel, en una macro tengo un formulario con dos textbox, uno sirve para poner la fecha inicial y otro la fecha final y tengo el siguiente código:

Private Sub CommandButton1_Click()
FechaI = Format(TextBox1, "M/DD/YYYY")
FechaF = Format(TextBox2, "M/DD/YYYY")
On Error GoTo cError
fIni = Workbooks("Archivo.xlsm").Worksheets("libro1").Cells.Find(What:=FechaI, SearchDirection:=xlNext).Address
fFin = Workbooks("Archivo.xlsm").Worksheets("libro1").Cells.Find(What:=FechaF, SearchDirection:=xlPrevious).Address
If fFin < fIni Then
    MsgBox "la fecha final no puede ser mayor a la inicial"
    Else
        Vf = Range(fFin).Offset(, 43).Address
        Vf2 = Range(fFin).Offset(, 43).Column
        Application.Union(Range("b1:AS1"), Range(fIni, Vf)).Copy
        Workbooks.Add
        ActiveSheet.Paste Destination:=Range("A1")
        Unload Me
End If
Exit Sub
cError:
MsgBox "Revisa que el formato de la fecha sea el adecuado"
End Sub

funciona bien, hasta que en la fecha inicial no hay ninguna captura, por lo tanto me manda al mensaje "Revisa que el formato de fecha sea adecuado"

Con este problema presente, quisiera encontrar la forma en que el valor ingresado en el Textbox1 si no existe se pase al siguiente valor cercano.

2 Respuestas

Respuesta
1

Ya quedó solucionado mi código quedó así:

Private Sub CommandButton1_Click()
On Error GoTo cError 'control de error mal formato de fecha
aux2 = Sheet2.Cells(Rows.Count, "B").End(xlUp).Row
FechaI = CDate(TextBox1)
FechaF = CDate(TextBox2)
rangoH = Workbooks("Registro").Sheets("Libro2").ListObjects("table2").HeaderRowRange.Copy 'selección de cabecera
If FechaF < FechaI Then 'validación de fechas
    MsgBox "La Fecha Final no puede ser mayor a la inicial"
    Unload Me
Else
    Workbooks.Add
    ActiveSheet.Paste Destination:=Range("A1")
    For i = 2 To aux2 'se agrega los registros filtrados por fecha
        dato0 = CDate(Workbooks("Registro").Sheets("Libro2").Cells(i, 2).Value)
        If dato0 >= FechaI And dato0 <= FechaF Then
            Pegar = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
            rangoA = Workbooks("Registro").Sheets("Libro2").ListObjects("table2").ListRows(i).Range.Copy
            ActiveSheet.Paste Destination:=Range("A" & Pegar)
        End If
    Next i
End If
Application.CutCopyMode = False
Unload Me
Exit Sub
cError:
MsgBox "Revisa que el formato de la fecha sea el adecuado"
End Sub

Muchas gracias, excelente apoyo Programar Excel :)

Respuesta
1

Esto te puede ayudar

https://www.youtube.com/watch?v=enA0eFkkwuA&list=PLdK9H5dMIfQhCuim_Sw4MwbYx1Q5eqF9z

https://www.youtube.com/watch?v=dRV0jZVK61w&list=PLdK9H5dMIfQh-SBezPhSkrxxnh0o_UR9b

https://www.youtube.com/watch?v=7-3xxZFubSY&list=PLdK9H5dMIfQg6K5QP_TdqBwCgqFeA9DL_

https://www.youtube.com/watch?v=Ds9Phsl8P8w&list=PLdK9H5dMIfQh-SBezPhSkrxxnh0o_UR9bhttps://www.youtube.com/watch?v=jg59LhL9Bb8&list=PLdK9H5dMIfQhzaY7BFhXf4t7B3_odpTsE

https://www.youtube.com/watch?v=Pr4wEHChy8o&list=PLdK9H5dMIfQjCRgiCW9uxTfrZHetqVHz_

https://www.youtube.com/watch?v=L5rwY9KxFQw&list=PLdK9H5dMIfQh-SBezPhSkrxxnh0o_UR9b

https://www.youtube.com/watch?v=PQGKcUusH7w&list=PLdK9H5dMIfQh-SBezPhSkrxxnh0o_UR9b

Si necesitas mas aca hay

https://www.youtube.com/playlist?list=PLdK9H5dMIfQh-SBezPhSkrxxnh0o_UR9b 

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas