Excel VBA to select a date range and move it to a new sheet

Question

I'm trying to use an Excel VBA script to do a few things in one routine, I'm not sure if it's possible.

I have two VBA scripts, one of which I worked out and one of which I used a "macro recorder" for, and somehow I need to put them together... here goes:

Sub SaveWorkbookAsNewFile()
Dim CurrentWorkbook As String
Dim CurrentFormat As Long
Dim DStart As String
Dim DEnd As String

DStart = Application.InputBox("Please enter start date. (dd-mm-yyyy)")
DEnd = Application.InputBox("Please enter end date. (dd-mm-yyyy)")

CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat

ThisWorkbook.SaveAs DStart & " to " & DEnd
End Sub

This one works for the bit I need it for, which is to create 2 variables for a start & end date range, then save the document as that name.

Sub Macro2()
  Rows("5624:5679").Select
  Selection.Copy
  Windows("01-08-2015 to 09-09-2015.xlsm").Activate
    Sheets("Sheet1").Select
    Range("A1").Select
    ActiveSheet.Paste
  Windows("Dash 2014Test.xlsx").Activate
    Sheets("Sheet2").Select
    Rows("835:846").Select
    Application.CutCopyMode = False
    Selection.Copy
  Windows("01-08-2015 to 09-09-2015.xlsm").Activate
    Sheets("Sheet2").Select
    ActiveSheet.Paste
  Windows("Dash 2014Test.xlsx").Activate
    Sheets("Sheet3").Select
    Rows("1611:1620").Select
    Application.CutCopyMode = False
    Selection.Copy
  Windows("01-08-2015 to 09-09-2015.xlsm").Activate
    Sheets("Sheet3").Select
    Range("A1").Select
    ActiveSheet.Paste
  Windows("Dash 2014Test.xlsx").Activate
End Sub

What I'd like to do is replace all the ranges in the second VBA script (the manual ranges) with the date variables from the first VBA script, for a one button solution (if possible). Any ideas? I've never been very good at working with dates in excel.

score 1 · Accepted Answer · edited May 23 '17 at 11:43

You're letting the user decide the format of the date by accepting the string they type in. Bad choice as users are notoriously unreliable. Convert the user input to a true date (and make them type it again if you cannot) then format the date(s) into a uniform string to be used in the filename using a format mask of your choosing.

Sub SaveWorkbookAsNewFile()
    Dim CurrentWorkbook As String
    Dim CurrentFormat As Long
    Dim dtStart As Date
    Dim dtEnd As Date

    On Error GoTo bm_SlapWrist
    dtStart = Application.InputBox("Please enter start date. (dd-mm-yyyy)")
    dtEnd = Application.InputBox("Please enter end date. (dd-mm-yyyy)")

    With ThisWorkbook
        CurrentWorkbook = .FullName
        CurrentFormat = .FileFormat
        .SaveAs Filename:=Format(dtStart, "dd-mm-yyyy to ") & Format(dtEnd, "dd-mm-yyyy"), _
                FileFormat:=CurrentFormat
    End With
    Call Macro2(ThisWorkbook.Name)
    Exit Sub

bm_SlapWrist:
    If Err.Number = 13 Then  'bad date: Type mismatch
        MsgBox "Try to get it right this time.", vbCritical, Title:="Bad User!"
        Err.Clear
        Resume
    End If

End Sub

The macro recorder is very verbose by necessity; trying to cover all possibilities with the widest scope of code. Generally speaking, the code delivered by the macro recorder can be parsed down considerably.

Sub Macro2(strWB As String)
    Dim wb As Workbook

    Set wb = Workbooks(strWB)

    'I'll assume that you started with this workbook since you keep going back to it.
    With Workbooks("Dash 2014Test.xlsx")
        'I do not know which worksheet you started on so I'll use Sheet1
        With .Worksheets("Sheet1")
            .Rows("5624:5679").Copy _
                Destination:=wb.Worksheets("Sheet1").Range("A1")
        End With
        With .Worksheets("Sheet2")
            .Rows("835:846").Copy _
                Destination:=wb.Worksheets("Sheet2").Range("A1")
        End With
        With .Worksheets("Sheet3")
            .Rows("1611:1620").Copy _
                Destination:=wb.Worksheets("Sheet3").Range("A1")
        End With
        .Activate
    End With
End Sub

See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.

score 0 · Answer 2 · answered Aug 08 '15 at 20:15

You're looking for the function Format which takes the date in input and converts it in string like this:

myString = Format(myDate, "dd-mm-yyyy")

Here's an example where FileName is a global variable declared in global scope, assigned in SaveWorkbookAsNewFile() and used in the Macro2:

Dim fileName As String
Sub SaveWorkbookAsNewFile()
'...
DStart = Application.InputBox("Please enter start date. (dd-mm-yyyy)")
DEnd = Application.InputBox("Please enter end date. (dd-mm-yyyy)")
fileName = Format(DStart,"dd-mm-yyyy") + " to " + Format(DEnd,"dd-mm-yyyy") + ".xlsm"
'...
End Sub

Hence, each time you just need to write :

Windows(fileName).Activate

As for the "one button solution", I guess you mean running both macros in one click only. You can simply call the Macro2 at the end of SaveWorkbookAsNewFile(), i.e.:

Sub SaveWorkbookAsNewFile()
'..
'all the code
'...
Macro2 '<-- calling the other macro
End Sub

score 0 · Answer 3 · answered Aug 08 '15 at 20:17

Put both subs into a single module. (Since you used the macro recorder, I assume it created a new module for your second sub...) To do this, just copy and paste the code.

To make this a one button solution, you will need to call the second sub from the first:

ThisWorkbook.SaveAs BillStart & " to " & BillEnd
Macro2 BillStart, BillEnd
End Sub

This will start Macro2 before the first sub is technically finished, so it comes on the same click of the button. However, notice that I put the variable names after Macro2. That will make it so we can use them in the next macro, but we need to make a tweak to Macro2 first:

Sub Macro2(BillStart as String, BillEnd as String)

Now you can use BillStart and BillEnd in Macro2 as well. (This is called "passing the variable")

To use them in a range, just use:

Range("A1").Value = BillStart

Excel VBA to select a date range and move it to a new sheet

3 Answers3