VBA/Macro to export data based on date inputs

[ForrestGump01]

Hi All,

I'm a novice VBA/Macro user, currently seeking some help with writing a dynamic macro.

I've got a process where I have to export a tab of data to a new workbook and save to a specific drive folder. OK, I've got the code for this written, and it works well (below). However, I need make the export dynamic based on whether certain columns are empty, and based on their dates...

The data is a budget reconciliation between two source tabs. In some instances we may need to reconcile past months of actual data, as well as forecast months going forward. However, historical and forecast data needs to be saved as separate files. Right now, my code saves the whole reconciliation as one file. I need to add in some code to separate the data based on if it is before the current month (say prior to July 2019) or current month and beyond (say July 2019 +). How can I add in this criteria and save as two separate exports? I'm not opposed to the criteria being tied to date "input" cells, where the user would manually identify the date ranges for each export, if this is easier than excel calculating the date ranges.

Here is my existing code:

Sub Generate_Buddie()
Dim newWB As Workbook, currentWB As Workbook
Dim newS As Worksheet, currentS As Worksheet


'Copy the data you need
Set currentWB = ThisWorkbook
Sheets("In-School Buddie").Select
Range("A:AS").Select
Selection.Copy


'Create a new file that will receive the data
Set newWB = Workbooks.Add
With newWB
Set newS = newWB.Sheets("Sheet1")
newS.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'Save in CSV
Application.DisplayAlerts = False
.SaveAs Filename:="H:\FACT Q3 - Consumer Finance Student\In-School Buddie", FileFormat:=xlCSV
Application.DisplayAlerts = True
End With



End Sub

 

[ForrestGump01]

Hi,
based on your first post & sample data provided, see if this code helps

ensure that you copy both codes

Sub Generate_Buddie()
    Dim SearchDate As Variant
    Dim FileName As String, ReportType As Variant
    Dim CurrentMonth As String, msg As String
    Dim lc As Long
    Dim DataRange As Range, cell As Range
    Dim wsInSchoolBuddie As Worksheet
    
    Set wsInSchoolBuddie = ThisWorkbook.Worksheets("In-School Buddie")
    
    With wsInSchoolBuddie
        lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
        Set DataRange = .Cells(1, 1).Resize(.Cells(.Rows.Count, "A").End(xlUp).Row, lc)
    End With
    
    On Error Resume Next
    Do
        CurrentMonth = MonthName(Month(Date), True) & " " & Year(Date)
        SearchDate = InputBox("Enter the Month and Year" & Chr(10) & "e.g - " & CurrentMonth, "Date Entry", CurrentMonth)
'cancel pressed
        If StrPtr(SearchDate) = 0 Then Exit Sub
'get the date
        SearchDate = DateValue("01/" & SearchDate)
'report error
        If Err <> 0 Then MsgBox "Invalid Date", 48, "Invalid": Err.Clear
    Loop Until IsDate(SearchDate)
'get last day of month
    SearchDate = CLng(Application.EoMonth(SearchDate, 0))
    
    On Error GoTo myerror
    
    For Each ReportType In Array("Forecast", "Historical")
'hide all columns not in date range based on report type
    For Each cell In wsInSchoolBuddie.Cells(1, 4).Resize(, lc).Columns
        cell.EntireColumn.Hidden = Not IIf(ReportType = "Forecast", cell.Value >= SearchDate, cell.Value < SearchDate)
    Next
    
'build filename
    FileName = "In-School Buddie " & ReportType & " - " & Format(Now(), "MM-DD-YY hh mm ss")


'create report
    CreateFile DataRange, FileName
'build msg response
    msg = msg & ReportType & IIf(ReportType = "Forecast", " >= ", " < ") & Format(SearchDate, "mmm yyyy") & Chr(10)
'unhide columns
    DataRange.Columns.Hidden = False
    
    Next
    
myerror:
    With Application
        .DisplayAlerts = True: .CutCopyMode = False: .ScreenUpdating = True
    End With
    If Err > 0 Then
        MsgBox (Error(Err)), 48, "Error"
    Else
        MsgBox msg & Chr(10) & Chr(10) & "Reports Created", 48, "Reports Created"
    End If
End Sub


Sub CreateFile(ByVal Target As Range, ByVal FileName As String)
    Dim newWB As Workbook
    Dim newWS As Worksheet
    Dim FilePath As String
    
'file path to save report(s)
   FilePath = "H:\FACT Q3 - Consumer Finance Student"
   
'check path exists
    If Not Dir(FilePath, vbDirectory) = vbNullString Then
    
        With Application
           .DisplayAlerts = False: .ScreenUpdating = False
        End With
    
        Set newWB = Workbooks.Add(1)
        Set newWS = newWB.Worksheets(1)
        
        Target.SpecialCells(xlCellTypeVisible).Copy newWS.Range("A1")
    
'Save in CSV
'note:format (csv) saves only the text and values as they are displayed in cells of the copied worksheet
'formatting and data might be lost, and other features might not be supported.
        With newWB
            .SaveAs FileName:=FilePath & "\" & FileName, FileFormat:=xlCSV
            .Close False
        End With
    Else
        Err.Raise 76
    End If
End Sub

When run an InputBox will appear displaying the current Month Year. You can change this as required.

Two reports should be created

Forecast - All dates > = month year entered

Historical - All dates < month year entered

Hopefully, this is what you were looking to achieve but adjust code as required.

Dave

Dave, this is perfect. Thank you very much! Quick question: To adapt this code to run this export process for 6 different tabs, can I simply copy-paste the code after each End to loop through all 6 tabs, and simply change the declarations and save-as names?

 

[dmt32]

Dave, this is perfect. Thank you very much! Quick question: To adapt this code to run this export process for 6 different tabs, can I simply copy-paste the code after each End to loop through all 6 tabs, and simply change the declarations and save-as names?

Hi,
pleased solution worked ok.

If the other worksheet structures are the same then although you could duplicate the code & amend it with required changes, better more flexiable approach is to make it common code where you can call it from different sheets & just pass the sheet name etc as arguments (like I did with create file code). Providing layout structure remains the same, This will allow you to add additional sheets at anytime with no changes to code needed.

If not sure how to do this, post copy of your additional sheets in your dropbox & will take a look

Dave

 

[ForrestGump01]

Hi,
pleased solution worked ok.

If the other worksheet structures are the same then although you could duplicate the code & amend it with required changes, better more flexiable approach is to make it common code where you can call it from different sheets & just pass the sheet name etc as arguments (like I did with create file code). Providing layout structure remains the same, This will allow you to add additional sheets at anytime with no changes to code needed.

If not sure how to do this, post copy of your additional sheets in your dropbox & will take a look

Dave

Dave,

The remaining 5 sheets are structured exactly the same as the one that you just graciously helped me export. My hope is to export all 6 sheets (12 exports total) with the click of that single "Generate" macro button. I can achieve this by simply adding additional strings of that macro you posted amended for new sheet names?

 

[dmt32]

Dave,

The remaining 5 sheets are structured exactly the same as the one that you just graciously helped me export. My hope is to export all 6 sheets (12 exports total) with the click of that single "Generate" macro button. I can achieve this by simply adding additional strings of that macro you posted amended for new sheet names?

You should be able to but will either need to modify code to include all sheets or as I suggested, make it a common code & pass sheet names & any other arguments needed like filename for each sheet.

Bit difficult to offer any guidance without understanding the differences you want to apply. If want to create a workbook with the 6 sheets & add to dropbox with explanation of where want to get to, will see if can add modification


Dave

 

[ForrestGump01]

You should be able to but will either need to modify code to include all sheets or as I suggested, make it a common code & pass sheet names & any other arguments needed like filename for each sheet.

Bit difficult to offer any guidance without understanding the differences you want to apply. If want to create a workbook with the 6 sheets & add to dropbox with explanation of where want to get to, will see if can add modification


Dave

Hi Dave,

Your solution was tremendously helpful and has provided me with a very useful macro for the past couple months. However, now I need to modify the macro slightly, and I'm not sure which part of the code will do what I need it to do. I've pasted the VBA as i currently am using it below. Right now the "date input" function splits the date range at a specific point (e.g. historical and forecast). I need to split into three sections: Historical, Forecast Year 1, Forecast Year 2. I imagine it will be as simple as just inputting a range instead of a specific date, and saying "export everything before X, between X and Y, and After Z as three different reports", however I am unsure... Any help is greatly appreciated.



Sub Generate_Buddie_Reports()

Dim SearchDate As Variant
Dim FileName As String, ReportType As Variant
Dim CurrentMonth As String, msg As String
Dim lc As Long
Dim DataRange As Range, cell As Range
Dim wsTESTBOOK As Worksheet

'TESTBOOK


Set wsTESTBOOK = ThisWorkbook.Worksheets("TESTBOOK")

With wsInSchoolBuddie
lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set DataRange = .Cells(1, 1).Resize(.Cells(.Rows.Count, "A").End(xlUp).Row, lc)
End With

On Error Resume Next
Do
CurrentMonth = MonthName(Month(Date), True) & " " & Year(Date)
SearchDate = InputBox("TESTBOOKl: Enter the Month and Year" & Chr(10) & "e.g - " & CurrentMonth, "Date Entry", CurrentMonth)
'cancel pressed
If StrPtr(SearchDate) = 0 Then Exit Sub
'get the date
SearchDate = DateValue("01/" & SearchDate)
'report error
If Err <> 0 Then MsgBox "Invalid Date", 48, "Invalid": Err.Clear
Loop Until IsDate(SearchDate)
'get last day of month
SearchDate = CLng(Application.EoMonth(SearchDate, 0))

On Error GoTo myerror

For Each ReportType In Array("Forecast", "Historical")
'hide all columns not in date range based on report type
For Each cell In wsInSchoolBuddie.Cells(1, 4).Resize(, lc).Columns
cell.EntireColumn.Hidden = Not IIf(ReportType = "Forecast", cell.Value >= SearchDate, cell.Value < SearchDate)
Next

'build filename
FileName = "TESTBOOK " & ReportType & " - " & Format(Now(), "MM-DD-YY")




'create report
CreateFile DataRange, FileName
'build msg response
msg = msg & ReportType & IIf(ReportType = "Forecast", " >= ", " < ") & Format(SearchDate, "mmm yyyy") & " - In-School" & Chr(10)
'unhide columns
DataRange.Columns.Hidden = False

Next