inputbox for date

fastballfreddy

Board Regular
Joined
Jan 13, 2015
Messages
60
Office Version
  1. 2016
Platform
  1. Windows
I have 2 workbooks. One is named MMDDYY and that changes daily. For my other workbook I am needing help creating an inputbox where i can type in a date MMDDYY and it will insert that date into my coding so it will select that workbook and grab the info needed. Below i have simple example of my code where the workbook name is 031324.xlsx. Appreciate any help with this as I'm currently updating the code daily for the date I know there has to be a way to use input box to update this quicker.

SQL:
Sub Macro2()
'
' Macro2 Macro
'

'
    Windows("031324.xlsx").Activate
    Range("A2:A7").Select
    Selection.Copy
    Windows("Book1").Activate
    ActiveSheet.Paste
End Sub
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
You will need a variable that will work as a name for the file, a directory location, and a checker to verify that the workbook exist before you try and manipulate it.

There are multiple ways to go about doing this, but this is the approach I would take.

VBA Code:
Sub InboxAndOpen()

    Dim Loc As String
    Dim Nme As String
    
    'set location of directory for files
    Loc = "C:\SampleLocation"
    
    'ask the name or date of file
    Dim Result As Variant
    Result = InputBox("Please type in date in this format: MMDDYY", "Date Picker")
    Nme = Result
    
    'replace any date deviders if any was entered
    Nme = Replace(Nme, "/", "")
    Nme = Replace(Nme, "\", "")
    Nme = Replace(Nme, "-", "")
    Nme = Replace(Nme, ".", "")
    Nme = Replace(Nme, ",", "")
    
    'add excel extention to file
    Nme = Nme & ".xlsx"
    
    
    'check to see if directory exist
    If Dir(Loc & "\" & client, vbDirectory) = "" Then
        MsgBox ("Directory not found at '" & Loc & "'.")
        Exit Sub
    End If
    
    'create a full directory with file
    Dim FullFile As String
    FullFile = Loc & "\" & Nme
    
    'check to see if file exist
    Dim obj_fso As Object
    Set obj_fso = CreateObject("Scripting.FileSystemObject")
    If obj_fso.fileExists(FullFile) = False Then
        MsgBox ("Date name of '" & Nme & "' does not exist.")
        Exit Sub
    Else
        'here you can do whatever you want with your file
        Dim wb As Workbook
        Set wb = Workbooks.Open(FullFile)
        
        Dim ws As Worksheet
        Set ws = wb.ActiveSheet
        
        ws.Range("A2:A7").Select
        Selection.Copy
        
        ThisWorkbook.ActiveSheet.Paste
        
    End If

End Sub
 
Upvote 1
Thanks! That works! I do have an additional question which I should have clarified earlier (sorry). I have different tabs on the file I am opening up that I want to copy and paste to the new excel file. for example tab names Joe, Mary, Tom and Meg. Once the code opens the file 031424.xlsx how would i tell it to grab from each tab? the names will stay consistent each day and I'll be pulling data from the same cells A2:A7.
 
Upvote 0
how would i tell it to grab from each tab?
The tabs are known as 'sheets'.
You can either hard code them in as such:

VBA Code:
Sheets("Joe").Range("A1:B200").Select 'just as an example

or if they are going to stay the same throughout, you can modify the 'ws' name in the pervious post to whatever you need.

VBA Code:
        Dim ws As Worksheet
        Set ws = wb.ActiveSheet
        Set ws = wb.Sheets("Joe")
 
Upvote 1
Solution
Thanks again! I'm almost there but stuck. Below is the end of the code to grab Mary's data which works great but when I try to get back to Report 031424.xlsx to grab Joe's data nothing seems to be working that I try.

VBA Code:
Dim wb As Workbook
Set wb = Workbooks.Open(FullFile)
Dim ws As Worksheet
Set ws = wb.ActiveSheet
Set ws = wb.Sheets("Mary")

Range("A2:A7").Select
Selection.Copy
Windows("Daily Report.xlsm").Activate
Range("B2").Select
Selection.PasteSpecial Paste:=x1PasteValues, Operation:=x1None, SkipBlanks:=False, Transpose:=False

End If
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top