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.
Code:
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