Hi All, I have been using this macro for a few days trying to export sheet data to a new workbook based on todays date. The code is always triggering the error handler saying it did not find the date (today). 75% of the time, the correct data does get exported properly. Sometimes the exported sheet is simply blank. Not sure what I have here that is wrong. I have been trying to even modify my date column to different formats, but no luck there either. Any help would be great.
Option Explicit Sub ExportDate() On Error GoTo ErrHandler Dim fDate, uName fDate = Format(Now, "mm.dd.yyyy.hh.mm") uName = Environ("username") Dim Last_Row As Long, Next_Row As Long, First_Find As Long Dim Range_Value As Range, a As Variant, i As Integer Dim Today_Date As Date, ws1 As Worksheet, ws2 As Worksheet Application.ScreenUpdating = False Today_Date = Date Set ws1 = Sheets("Sheet1"): Set ws2 = Sheets("ExportData"): ws1.Select Next_Row = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1 Last_Row = ws1.Range("A" & Rows.Count).End(xlUp).Row Set Range_Value = Range(Cells(2, "E"), Cells(Last_Row, "E")) With Range_Value Set a = .Find(What:=Today_Date, LookAt:=xlPart) First_Find = a.Row Do a.EntireRow.Copy Destination:=ws2.Cells(Next_Row, 1): Next_Row = Next_Row + 1 Set a = .FindNext(a) Loop While (a.Row <> First_Find) End With ws2.Select: Set ws1 = Nothing: Set ws2 = Nothing: Set Range_Value = Nothing Worksheets("ExportData").Copy 'Export to new file With ActiveWorkbook .SaveAs Filename:=ThisWorkbook.Path & "\4-9999-012" & "_" & fDate & "_" & uName & ".xlsx", FileFormat:=xlOpenXMLWorkbook .Close savechanges:=False End With Sheets("ExportData").Cells.Clear Application.ScreenUpdating = True ErrHandler: MsgBox "No Date Found for: " & Today_Date, vbExclamation, "" Exit Sub End Sub