Hi, I wonder whether someone may be able to help me please.
I'm using the code below to allow a user to open, and extract a number of 'Source' files creating a "Summary" sheet from the extracted data.
I'd now like to make a change to this, but I'm very unsure about how to go about it.
Upon selecting to run the macro, I would like the user to be presented with an 'Input box', so they can type the name of the 'Month' folder they wish to open.
Then, when this action has been performed, automatically open the "Time Recording" sub folder, then automatically and extract the data from the 'Source' files in this, as per the current functionality.
The initial file path is as follows:
\\irf1234\r and d management\D&RM\Reporting\Chris Test
Then the user will enter the 'Month' folder name, so the file path will for example be:
\\irf1234\r and d management\D&RM\Reporting\Chris Test\November
From this, I'd like to automatically open the "Time Recording" subfolder and extract the data from the 'Source' files.
As mentioned earlier in my post, I'm not sure how to proceed with this, but I just wondered whether someone could possibly look at this please and offer some guidance on how may go about achievin this please.
Many thanks and kind regards
I'm using the code below to allow a user to open, and extract a number of 'Source' files creating a "Summary" sheet from the extracted data.
Code:
Sub ConsolidateTimeRecording()
Dim DestWB As Workbook
Dim dR As Long
Dim Fd As FileDialog
Dim LastRow As Long
Dim SourceSheet As String
Dim sFile As String
Dim sPath As String
Dim StartRow As Long
Dim wb As Workbook
Dim ws As Worksheet
Set DestWB = ActiveWorkbook
SourceSheet = "Input"
StartRow = 2
Range("B4:N4").Select
Selection.AutoFilter
' Select the folder that contains the files
Set Fd = Application.FileDialog(msoFileDialogFolderPicker)
With Fd
'.InitialFileName = "DefaultPath"
If .Show = -1 Then
sPath = Fd.SelectedItems(1) & "\"
End If
End With
Set Fd = Nothing
' Directory in the folder
sFile = Dir(sPath)
Do While sFile <> ""
Set wb = Workbooks.Open(Filename:=sFile, ReadOnly:=True, Password:="master")
For Each ws In wb.Worksheets
If ws.Name = SourceSheet Then
With ws
If .UsedRange.Cells.count > 1 Then
dR = DestWB.Worksheets("Time Recording").Range("B" & DestWB.Worksheets("Time Recording").Rows.count).End(xlUp).Row + 1
If dR < 5 Then dR = 6 'destination start row
LastRow = .Range("A" & Rows.count).End(xlUp).Row
If LastRow >= StartRow Then
.Range("A" & StartRow & ":M" & LastRow).Copy
DestWB.Worksheets("Time Recording").Cells(dR, "B").PasteSpecial xlValues
DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Name = "Lucida Sans"
DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Size = 10
DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).NumberFormat = "#,##0.00"
DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).HorizontalAlignment = xlCenter
End If
End If
End With
Exit For
End If
Next ws
wb.Close savechanges:=False
' Next file in folder
sFile = Dir
Loop
Application.CutCopyMode = False
msg = MsgBox("All Time Recording files have been consolidated", vbInformation)
Columns("B:N").AutoFit
End Sub
I'd now like to make a change to this, but I'm very unsure about how to go about it.
Upon selecting to run the macro, I would like the user to be presented with an 'Input box', so they can type the name of the 'Month' folder they wish to open.
Then, when this action has been performed, automatically open the "Time Recording" sub folder, then automatically and extract the data from the 'Source' files in this, as per the current functionality.
The initial file path is as follows:
\\irf1234\r and d management\D&RM\Reporting\Chris Test
Then the user will enter the 'Month' folder name, so the file path will for example be:
\\irf1234\r and d management\D&RM\Reporting\Chris Test\November
From this, I'd like to automatically open the "Time Recording" subfolder and extract the data from the 'Source' files.
As mentioned earlier in my post, I'm not sure how to proceed with this, but I just wondered whether someone could possibly look at this please and offer some guidance on how may go about achievin this please.
Many thanks and kind regards