VBA to pull data from closed excel workbooks to Master within sub folder structures

[JaLoXL]

Hi,

I have been searching for a solution to this issue for quite some time with no luck, some findings get me a portion of the way but not quite what I need. I do not have any VBA experience but I am very competent with formula writing.

I need to pull data ranges from closed, excel sheets stored on a shared drive (F:\STRUCTURES\ACCOUNTS\Cost Tracking\BUDGETS\COSTINGS\EMPLOYEE ANALYSIS), these documents are stored firstly via Month January/February/March etc then Week Commencing 01.01.19/08.01.19/15.01.19. Within each of the Week Commencing folders there are a number of Spreadhseets but I need to look inside only one - 'Labour Test File'. Within this workbook I need to extract the range B3:AA42 from the worksheet named 'Analysis - Costs'.

When this data has been found I would want this to paste into a document stored on the same file path named 'Master', using the next available to row to paste the next week's data.

Your help would be greatly appreciated on this as I have been struggling to find a suitable solution for this for some time.

 

[Yongle]

I have thought about building the sheets with formulas this way but as the will be Month folders not yet created I would like the VBA code to look for all workbooks created with the name 'Labour Test File' and pull down the information contained within 'Analysis - Costs'.

I am not intending for Master to contain the all formulas
- but possiblly to bring values into the workbook via VBA using those formulas

Please test the formula and let me know
- thanks

 

[Yongle]

What I know
Master.xlsm is in same folder as Labour Test File.xlsx. VBA resides in Master. Values go in next available row in "Sheet 1"

What I need
Q1 Does data go in columns A:Z (or B:AA) ?
Q2 How does VBA get told which is the next week to pull ?
- user option ? \ does previous data tell us ?\ get VBA to update a cell in Master each time
Q3 Did the formula work ? (see post#11 & post#5)

 

[Yongle]

Next test (takes account of your replies)
- place code below in a test copy of Master.xlsm
- run a few times amending month and week in the 2 input boxes
- are values correctly pasted?

Completion?
- replies to questions in post#12 should get us very close

Sub GetValues()
    Dim fMonth As String, fWkComm As String, varPath As String, s As String, fullPath As String
    Dim ws As Worksheet, wb As Workbook, nextRow As Long
    Const fPath = "F:\STRUCTURES\ACCOUNTS\Cost Tracking\BUDGETS\COSTINGS\EMPLOYEE ANALYSIS"
    Const fName = "Labour Test File.xlsx"
    Const fSheet = "Analysis - Costs"
    Const fRng = "B3:AA42"
    Const pSheet = "Sheet 1"                                [COLOR=#ff0000]'as per your answer in post#7[/COLOR]
    Const pColumn = "A"                                     [COLOR=#ff0000]'assumes data is being pasted to A:Z[/COLOR]
'variable elements
    fMonth = "January"
    fWkComm = "08.01.19"
    fMonth = InputBox("Enter month", "MONTH ?", fMonth)     [COLOR=#ff0000]'to test by manual input[/COLOR]
    fWkComm = InputBox("Enter week", "WEEK ?", fWkComm)     [COLOR=#ff0000]'to test by manual input[/COLOR]
    s = Application.PathSeparator
'full path string
    fullPath = fPath & s & fMonth & s & fWkComm & s & fName
'test if file exists
    If Dir(fullPath) > "" Then
        Set wb = Workbooks.Open(fullPath)
    Else
        MsgBox "File not found"
        Exit Sub
    End If
'get values
    Set ws = ThisWorkbook.Sheets(pSheet)
    [COLOR=#ff0000]nextRow[/COLOR] = ws.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1
    wb.Sheets(fSheet).Range(fRng).Copy ws.Cells([COLOR=#ff0000]nextRow[/COLOR], [COLOR=#ff0000]pColumn[/COLOR])
    wb.Close False 'close without saving
End Sub

 

[JaLoXL]

I am not intending for Master to contain the all formulas
- but possiblly to bring values into the workbook via VBA using those formulas

Please test the formula and let me know
- thanks

Hi Yongle,

I see, yes entering that file path formaula pulls through the data.

Thanks

 

[Yongle]

Iyes - entering that file path formala pulls through the data

Excellent

I'll post an updated solution AFTER you have tested the code (post#14) and answered the questions (post#12)
- we'll work on that to get a ("copy & paste") solution" finalised

After that, the alternative "formulas equivalent" solution can be shoe-horned in to the tail-end of the code
(you may not want to use it here, but it may be useful for something else later and the method is already proven)

 

[JaLoXL]

Next test (takes account of your replies)
- place code below in a test copy of Master.xlsm
- run a few times amending month and week in the 2 input boxes
- are values correctly pasted?

Completion?
- replies to questions in post#12 should get us very close

Sub GetValues()
    Dim fMonth As String, fWkComm As String, varPath As String, s As String, fullPath As String
    Dim ws As Worksheet, wb As Workbook, nextRow As Long
    Const fPath = "F:\STRUCTURES\ACCOUNTS\Cost Tracking\BUDGETS\COSTINGS\EMPLOYEE ANALYSIS"
    Const fName = "Labour Test File.xlsx"
    Const fSheet = "Analysis - Costs"
    Const fRng = "B3:AA42"
    Const pSheet = "Sheet 1"                                [COLOR=#ff0000]'as per your answer in post#7[/COLOR]
    Const pColumn = "A"                                     [COLOR=#ff0000]'assumes data is being pasted to A:Z[/COLOR]
'variable elements
    fMonth = "January"
    fWkComm = "08.01.19"
    fMonth = InputBox("Enter month", "MONTH ?", fMonth)     [COLOR=#ff0000]'to test by manual input[/COLOR]
    fWkComm = InputBox("Enter week", "WEEK ?", fWkComm)     [COLOR=#ff0000]'to test by manual input[/COLOR]
    s = Application.PathSeparator
'full path string
    fullPath = fPath & s & fMonth & s & fWkComm & s & fName
'test if file exists
    If Dir(fullPath) > "" Then
        Set wb = Workbooks.Open(fullPath)
    Else
        MsgBox "File not found"
        Exit Sub
    End If
'get values
    Set ws = ThisWorkbook.Sheets(pSheet)
    [COLOR=#ff0000]nextRow[/COLOR] = ws.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1
    wb.Sheets(fSheet).Range(fRng).Copy ws.Cells([COLOR=#ff0000]nextRow[/COLOR], [COLOR=#ff0000]pColumn[/COLOR])
    wb.Close False 'close without saving
End Sub

Hi,

I don't think we are too far away.

However, I'm getting a run time error '9' message on the line - Set ws = ThisWorkbook.Sheets(pSheet)

 

[Yongle]

However, I'm getting a run time error '9' message on the line - Set ws = ThisWorkbook.Sheets(pSheet)


The name is wrong
- I used what you provided
- should there be a space before the 1 ?

Enter the name correctly into this line and try again

Const pSheet = "Sheet 1"

 

[JaLoXL]

However, I'm getting a run time error '9' message on the line - Set ws = ThisWorkbook.Sheets(pSheet)


The name is wrong
- I used what you provided
- should there be a space before the 1 ?

Enter the name correctly into this line and try again

Const pSheet = "Sheet 1"

Hi Yongle,

The error was on my part apologies it was 'Sheet1'

When rerun a debug error message is displaying - Run time error 91: Object variable or With block variable not set on line:
nextRow = ws.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1

At this point it is worth noting that due to shortfalls in my original spec I have amended your original code:
'variable elements
fMonth = "April 2019"
fWkComm = "WC 15.04.19"

Would this be the cause of the run time error?

Thanks again.

 

[Yongle]

'variable elements
fMonth = "April 2019"
fWkComm = "WC 15.04.19"

That bit of info is helpful
- I will adjust my code to match your latest info so that you should not need to alter my code EVERY time I update anything!
- also vital for the formula bit later

When rerun a debug error message is displaying - Run time error 91: Object variable or With block variable not set on line:
nextRow = ws.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1

Would this be the cause of the run time error?

Is the sheet EMPTY ?
- that would generate that specific error because VBA cannot find a value
- I expected your test file to contain headers
- try placing a value somewhere in row 1 and run again
- data should copy to row 2 onwards

 

[JaLoXL]

That bit of info is helpful
- I will adjust my code to match your latest info so that you should not need to alter my code EVERY time I update anything!
- also vital for the formula bit later


Is the sheet EMPTY ?
- that would generate that specific error because VBA cannot find a value
- I expected your test file to contain headers
- try placing a value somewhere in row 1 and run again
- data should copy to row 2 onwards

Hi,

Yes, I entered data on the first line and it pulled the information through, great stuff.

The data being extracted has a title bar and and a total column which can be removed, this will this alter the range to B5:AA41