• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA Code Error when exporting sheet data to new workbook

Nu2Java

Member
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
 
At glance below line is likely culprit.
Code:
Set Range_Value = Range(Cells(2, "E"), Cells(Last_Row, "E"))

Everywhere else, it looks like you are qualifying range/cells with parent sheet object (ws1, ws2 etc), but here, you are missing it.

So sometimes, when you have different worksheet than intended one active, it may give you back no data, or only partial data.
 
@Chihiro ...thank you for that good catch. I changed to ws1.Range & ws1.Cells but still have the same result throwing the error message. I get the data, but not certain why the error is thrown every time
 
What's the exact error message and when you debug. What line is highlighted?

If possible, I'd strongly recommend uploading sample workbook that's representative of your workbook. It'll make it so much easier for us to help you.
 
This is what I am getting when the error handler fires. Seems to appear at the time of saving the new workbook containing the data.

Code:
Application-defined or object-defined error
 
Hmm that's likely this part.
Code:
  With ActiveWorkbook

        .SaveAs Filename:=ThisWorkbook.Path & "\4-9999-012" & "_" & fDate & "_" & uName & ".xlsx", FileFormat:=xlOpenXMLWorkbook
        .Close savechanges:=False

  End With
.SaveAs may change ActiveWorkbook context.
Instead of using ActiveWorkbook. It's best to set specific workbook.

But as I stated before, it's so much easier to help if you upload sample workbook (with desensitized info) that replicates your issue.
 
Back
Top