option to get data by month or week

swallis

Board Regular
Joined
May 19, 2012
Messages
96
This is a workbook called Production and the objective files are in the Path C:\ ~\~\~\Sales\Year\Month\Week\files.xls. The macro below opens the file dialog box in Year and the user drills down to the required Week. The macro copies a list of the files in the Week folder to Sheet “Master” in Production, then opens each file in the Week folder and closes it, after copying data across to Sheet “All” in Production.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p></o:p>
<o:p></o:p>
I would like to allow the user the option to run the macro from either the Week or Month folder. If the latter is chosen, the macro would list and copy data from each weekly folder in the month. If it’s simpler to have one or the other, I would choose Month<o:p></o:p>
<o:p></o:p>
A related issue is to somehow simply change the Year the dialog box opens in to the current year – without asking anybody to change the code. I (vba challenged) am doing this for a friend (vba ignorant) and may not always be maintaining it.<o:p></o:p>
<o:p></o:p>
Finally, the code works in Excel 2003, but has to translate to Excel 2007 (I know file type has to change). It’s been cobbled together by a combination of search, copy, paste and fiddle. If anyone feels the urge to tidy it up, simplify it or make it more efficient, I’d be very appreciative. <o:p></o:p>

Code:
Sub GetData()
Dim fPATH As String, fNAME As String, NR As Long
Dim wsALL As Worksheet, ws As Worksheet, wbDATA As Workbook
Dim xRow As Long
Dim blnFlag As Boolean
Dim xDirect$, xFname$
    Sheets("Master").Select
    Cells(Rows.Count, "a").End(xlUp).Offset(1).Select
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "C:\Users\Steve\Desktop\Public Files\Products\Sales\Sales 12"
        .Title = "Choose Folder"
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count <> 0 Then
            xDirect$ = .SelectedItems(1) & "\"
            xFname$ = Dir(xDirect$, 7)
            Do While xFname$ <> ""
                blnFlag = True
                ActiveCell.Offset(xRow) = xFname$
                xRow = xRow + 1
                xFname$ = Dir
            Loop
        End If
        If .SelectedItems.Count <> 0 Then
            fPATH = .SelectedItems(1) & "\"
            fNAME = Dir(fPATH & "*.xl*")
            Do While Len(fNAME) > 0
            Set wbDATA = Workbooks.Open(fPATH & fNAME)
            Sheets("Sheet1").Select
            Range("A16", Range("d16").End(xlDown)).Select
            Selection.Copy
            Workbooks("Production.xlsm").Activate
            Sheets("All").Select
            Cells(Rows.Count, "a").End(xlUp).Offset(1).Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
              With Selection.Font
                   .Name = "Arial"
                   .Size = 10
              End With
             wbDATA.Close False
            fNAME = Dir
            Loop
        End If
    End With
    If blnFlag = False Then MsgBox "No files found"
End Sub
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

Forum statistics

Threads
1,213,513
Messages
6,114,072
Members
448,546
Latest member
KH Consulting

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