VBA Pulling data into sheet from closed workbooks

J

jamescooper

Well-known Member
Joined
Sep 8, 2014
Messages
840
Hello, in the second macro - forecast_day_2, it does not pull the values. the forecast_day_1 it returns them all - is there any obvious errors with this pulling of values into my spreadsheet?

Many thanks

Code: 
Dim myvalue3 As Variant
    Dim destcell As Range, r As Long
    Dim fileSpec As String, folderPath As String, fileName As String
    Dim FilePath As String
    Dim TestStr As String
    Dim FP As String, FN As String
Option Compare Text


Sub Forecast_Day_1()


    Dim destcell As Range, r As Long
    Dim fileSpec As String, folderPath As String, fileName As String
    Dim FilePath As String
    Dim TestStr As String
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim FP As String, FN As String
                
    Dim Found As Boolean
    Dim z As Byte
    Dim Items() As String


    Items = Split("1710,1711,1712,1713,1801,1802,1803,1804,1805,1806,1807,1808,1809,1810,1811,1812,1813,1901,1902,1903,1904,1905,1906,1907,1908,1909,1910,1911,1912,1913,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011,2012,2013,2101,2102,2103,2104,2105,2106,2107,2108,2109,2110,2111,2112,2113,2201,2202,2203,2204,2205,2206,2207,2208,2209,2210,2211,2212,2213,2301,2302,2303,2304,2305,2306,2307,2308,2309,2310,2311,2312,2313,2401,2402,2403,2404,2405,2406,2407,2408,2409,2410,2411,2412,2413,2501,2502,2503,2504,2505,2506,2507,2508,2509,2510,2511,2512,2513,2601,2602,2603,2604,2605,2607,2608,2609,2610,2611,2612,2613,2701,2702,2703,2704,2705,2706,2707,2708,2709,2710,2711,2712,2713,2801,2802,2803,2804,2805,2806,2807,2808,2809,2810,2811,2812,2813,2901,2902,2903,2904,2905,2906,2907,2908,2909,2910,2911,2912,2913,3001,3002,3003,3004,3005,3006,3007,3008,3009,3010,3011,3012,3013", ",")
    Found = False
    Do
    myvalue3 = InputBox("Enter the railway period, e.g. 1804")
    If StrPtr(myvalue3) = 0 Then Exit Sub
    For z = LBound(Items) To UBound(Items)
        If myvalue3 = Items(z) Then Found = True
    Next
    Loop While Not Found


    Dim NoFile As Boolean
    NoFiles = False
       
    FD = Workbooks("Schedule 4 Model.xlsm").Worksheets("Sheet1").Range("Z1")
        
    Workbooks.Open fileName:= _
    FD & "Forecast\Forecast Template.xlsx"


    Sheets("Summary").Range("C3").Value = myvalue3
    
    cellvalue1 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("U6")
    dow1 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("V6")
       
    FilePath = FD & "Revenue\" & myvalue3 & "\" & cellvalue1
    
    TestStr = ""
    On Error Resume Next
    TestStr = Dir(FilePath)
    On Error GoTo 0
    If TestStr = "" Then
    Call Forecast_Day_2
    Else
    
    fileSpec = FD & "Revenue\" & myvalue3 & "\" & cellvalue1 & ""
       
    Set destcell1 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("C6")
    Set destcell2 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("D6")
    Set destcell3 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("E6")
    Set destcell4 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("F6")
    Set destcell5 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("G6")
    Set destcell6 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("H6")
    Set destcell7 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("I6")
    Set destcell8 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("J6")
    Set destcell9 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("K6")
    Set destcell10 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("L6")
    Set destcell11 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("M6")
    Set destcell12 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("N6")
    
        r = 0
    
    folderPath = Left(fileSpec, InStrRev(fileSpec, "\"))
    
    fileName = Dir(fileSpec)
    
    While Len(fileName) <> 0
    
    destcell1.Offset(r, 0).Value = GetCellValue(folderPath & fileName, "Forecast", dow1 & 12)
    destcell2.Offset(r, 0).Value = GetCellValue(folderPath & fileName, "Forecast", dow1 & 20)
    destcell3.Offset(r, 0).Value = GetCellValue(folderPath & fileName, "Forecast", dow1 & 28)
    destcell4.Offset(r, 0).Value = GetCellValue(folderPath & fileName, "Forecast", dow1 & 37)
    destcell5.Offset(r, 0).Value = GetCellValue(folderPath & fileName, "Forecast", dow1 & 48)
    destcell6.Offset(r, 0).Value = GetCellValue(folderPath & fileName, "Forecast", dow1 & 55)
    destcell7.Offset(r, 0).Value = GetCellValue(folderPath & fileName, "Forecast", dow1 & 64)
    destcell8.Offset(r, 0).Value = GetCellValue(folderPath & fileName, "Forecast", dow1 & 72)
    destcell9.Offset(r, 0).Value = GetCellValue(folderPath & fileName, "Forecast", dow1 & 80)
    destcell10.Offset(r, 0).Value = GetCellValue(folderPath & fileName, "Forecast", dow1 & 87)
    destcell11.Offset(r, 0).Value = GetCellValue(folderPath & fileName, "Forecast", dow1 & 96)
    destcell12.Offset(r, 0).Value = GetCellValue(folderPath & fileName, "Forecast", dow1 & 105)


        r = r + 1
        
        fileName = Dir
    
    Wend
    
Call Forecast_Day_2


End If
             
End Sub


Sub Forecast_Day_2()


    Dim destcell As Range, r As Long
    Dim fileSpec As String, folderPath As String, fileName As String
    Dim FilePath As String
    Dim TestStr As String
        
    cellvalue2 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("U7")
    dow2 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("V7")
    
    FD = Workbooks("Schedule 4 Model.xlsm").Worksheets("Sheet1").Range("Z1")
    
    FilePath = FD & "Revenue\" & myvalue3 & "\" & cellvalue2
    
    TestStr = ""
    On Error Resume Next
    TestStr = Dir(FilePath)
    On Error GoTo 0
    If TestStr = "" Then
    Call Forecast_Day_3
    Else
    
    fileSpec2 = FD & "Revenue\" & myvalue3 & "\" & cellvalue2 & ""
       
    Set destcell13 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("C7")
    Set destcell14 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("D7")
    Set destcell15 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("E7")
    Set destcell16 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("F7")
    Set destcell17 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("G7")
    Set destcell18 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("H7")
    Set destcell19 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("I7")
    Set destcell20 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("J7")
    Set destcell21 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("K7")
    Set destcell22 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("L7")
    Set destcell23 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("M7")
    Set destcell24 = Workbooks("Forecast Template.xlsx").Sheets("Revenue").Range("N7")
        
        r = 0
    
    folderPath2 = Left(fileSpec, InStrRev(fileSpec2, "\"))
    
    fileName2 = Dir(fileSpec2)
    
    While Len(fileName2) <> 0
    
    destcell13.Offset(r, 0).Value = GetCellValue(folderPath2 & fileName2, "Forecast", dow2 & 12)
    destcell14.Offset(r, 0).Value = GetCellValue(folderPath2 & fileName2, "Forecast", dow2 & 20)
    destcell15.Offset(r, 0).Value = GetCellValue(folderPath2 & fileName2, "Forecast", dow2 & 28)
    destcell16.Offset(r, 0).Value = GetCellValue(folderPath2 & fileName2, "Forecast", dow2 & 37)
    destcell17.Offset(r, 0).Value = GetCellValue(folderPath2 & fileName2, "Forecast", dow2 & 48)
    destcell18.Offset(r, 0).Value = GetCellValue(folderPath2 & fileName2, "Forecast", dow2 & 55)
    destcell19.Offset(r, 0).Value = GetCellValue(folderPath2 & fileName2, "Forecast", dow2 & 64)
    destcell20.Offset(r, 0).Value = GetCellValue(folderPath2 & fileName2, "Forecast", dow2 & 72)
    destcell21.Offset(r, 0).Value = GetCellValue(folderPath2 & fileName2, "Forecast", dow2 & 80)
    destcell22.Offset(r, 0).Value = GetCellValue(folderPath2 & fileName2, "Forecast", dow2 & 87)
    destcell23.Offset(r, 0).Value = GetCellValue(folderPath2 & fileName2, "Forecast", dow2 & 96)
    destcell24.Offset(r, 0).Value = GetCellValue(folderPath2 & fileName2, "Forecast", dow2 & 105)


        r = r + 2
        
        fileName2 = Dir
    
    Wend
    


    End If


End Sub


Private Function GetCellValue(ByVal workbookFullName As String, sheetName As String, cellsRange As String)


    Dim folderPath As String, fileName As String
    Dim arg As String
    
    folderPath = Left(workbookFullName, InStrRev(workbookFullName, "\"))
    fileName = Mid(workbookFullName, InStrRev(workbookFullName, "\") + 1)
    folderPath2 = Left(workbookFullName, InStrRev(workbookFullName, "\"))
    fileName2 = Mid(workbookFullName, InStrRev(workbookFullName, "\") + 1)


      
    arg = "'" & folderPath & "[" & fileName & "]" & sheetName & "'!" & Range(cellsRange).Address(True, True, xlR1C1)
    arg = "'" & folderPath2 & "[" & fileName & "]" & sheetName & "'!" & Range(cellsRange).Address(True, True, xlR1C1)
   
    Debug.Print arg
             
    GetCellValue = ExecuteExcel4Macro(arg)
    
End Function
 

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Sort by date Sort by votes
I believe you need to actually open the workbooks if they are closed... also you should declare variables so you can step through the code and debug easier...

opening workbook...

Code: 
cellvalue2 = Workbooks.Open("C:\[I](Put The Correct Folder)[/I]\Forecast Template.xlsx").Sheets("Revenue").Range("U7")
...
'then close when done
Workbooks(Forecast Template.xlsx").Close

easier debugging

Code: 
Dim cellvalue2 As Variant
Dim wbk As Workbook
Dim sheet As WorkSheet
Set wbk = Workbooks.Open("C:\[I](Put The Correct Folder)[/I]\Forecast Template.xlsx")
Set sheet = wbk.Sheets("Revenue")
cellvalue2 = sheet.Range("U7")
...
'then close when done
wbk.Close
 
Upvote 0
cerfani said:
I believe you need to actually open the workbooks if they are closed... also you should declare variables so you can step through the code and debug easier...

opening workbook...

Code: 
cellvalue2 = Workbooks.Open("C:\[I](Put The Correct Folder)[/I]\Forecast Template.xlsx").Sheets("Revenue").Range("U7")
...
'then close when done
Workbooks(Forecast Template.xlsx").Close

easier debugging

Code: 
Dim cellvalue2 As Variant
Dim wbk As Workbook
Dim sheet As WorkSheet
Set wbk = Workbooks.Open("C:\[I](Put The Correct Folder)[/I]\Forecast Template.xlsx")
Set sheet = wbk.Sheets("Revenue")
cellvalue2 = sheet.Range("U7")
...
'then close when done
wbk.Close
Click to expand...

Thanks the 1st one pulls the data fine - so I don't need to open it I do not believe? Will try adding

Dim cellvalue2 As Variant
 
Upvote 0
OK from what I remember, if a workbook is closed, you can't reference a range object from the workbook...

This code references an open workbook...

Code: 
Workbooks("Forecast Template.xlsx")

...and not a closed one so it means your workbook is already open (Workbooks object is a collection of open workbooks), so yeah you wouldnt need to open them then. You mentioned in the title they were closed which is why I suggested opening them. I would suggest declaring a variable for the workbook and sheet and then the Range and ensure they get referenced correctly. Is the value in U7 #Ref maybe?
 
Last edited:
Upvote 0
cerfani said:
OK from what I remember, if a workbook is closed, you can't reference a range object from the workbook...

This code references an open workbook...

Code: 
Workbooks("Forecast Template.xlsx")

...and not a closed one so it means your workbook is already open (Workbooks object is a collection of open workbooks), so yeah you wouldnt need to open them then. You mentioned in the title they were closed which is why I suggested opening them. I would suggest declaring a variable for the workbook and sheet and then the Range and ensure they get referenced correctly. Is the value in U7 #Ref maybe?
Click to expand...

There is the correct filepath is U7,

I think it is something to do with the folderpath bit when getting the cellvalue from the privatesub function?
Code: 
Private Function GetCellValue(ByVal workbookFullName As String, sheetName As String, cellsRange As String)


    Dim folderPath As String, fileName As String
    Dim arg As String
    
    folderPath = Left(workbookFullName, InStrRev(workbookFullName, "\"))
    fileName = Mid(workbookFullName, InStrRev(workbookFullName, "\") + 1)
    folderPath2 = Left(workbookFullName, InStrRev(workbookFullName, "\"))
    fileName2 = Mid(workbookFullName, InStrRev(workbookFullName, "\") + 1)


      
    arg = "'" & folderPath & "[" & fileName & "]" & sheetName & "'!" & Range(cellsRange).Address(True, True, xlR1C1)
    arg = "'" & folderPath2 & "[" & fileName & "]" & sheetName & "'!" & Range(cellsRange).Address(True, True, xlR1C1)
 
Upvote 0
In that code you posted, you are overwriting the value in the 'arg' variable because you set it twice, one after another. You are losing reference to the folder path that came from the variable 'folderPath' since you use 'folderPath2' to set 'arg' right after. Did you intend to save both file paths? Maybe you also need an 'arg2' for 'folderPath2' ??
 
Last edited:
Upvote 0
cerfani said:
In that code you posted, you are overwriting the value in the 'arg' variable because you set it twice, one after another. You are losing reference to the folder path that came from the variable 'folderPath' since you use 'folderPath2' to set 'arg' right after. Did you intend to save both file paths? Maybe you also need an 'arg2' for 'folderPath2' ??
Click to expand...

Tried that didn't work :(
 
Upvote 0
Check this code I made for something I was doing a while ago... maybe it will help you format the ranges correctly... your expression you are passing into execute excel 4 macro is maybe wrong??

Code: 
    Dim rangePrefix As String
    rangePrefix = "'X:\Pricing\Lookup Tables\Fuel\[Weekly Fuel.xlsx]Weekly'!"
    
    Dim i As Long, endOffset As Long
    Dim expression As String
    Dim returnValue As Variant
    Dim dateRange As Range
    
    endOffset = 1048576 - ActiveCell.Row
    For i = 0 To endOffset
        If IsEmpty(ActiveCell.Offset(i, columnOffset).Value) Then Exit Sub
        
        expression = "INDEX(" & rangePrefix & "R2C3:R2000C3,MATCH(VALUE(""" & ActiveCell.Offset(i, columnOffset).Value & """)," & rangePrefix & "R2C1:R2000C1,1))"
        returnValue = Application.ExecuteExcel4Macro(expression)
        ActiveCell.Offset(i, 0).Value = returnValue
    Next i
 
Last edited:
Upvote 0
cerfani said:
OK I actually looked a little further down your code and now I know what you are trying to do. You are looking up file paths for closed workbooks on an open workbook then using those file paths so you can reference in ExecuteExcel4Macro. But ExecuteExcel4Macro is not able to reference data in a closed workbook. You need to open those workbooks with vba and then you can reference them, then you can close them. And at that point you won't need to use ExecuteExcel4Macro.
Click to expand...

How is the first one managing to pull the data then without me opening it? I sort of understand.
 
Upvote 0
You must log in or register to reply here.

Similar threads

V
  • Question Question
VBA excel worksheet2 out of range even though the cell is within the range and additional value created
Replies
4
Views
229
MARK858
MARK858
H
  • Question Question
VBA split file based and send splitted file in separate emails
Replies
0
Views
706
harmless92
H
B
  • Question Question
Excel VBA Searching Unique Variables to Match against Exported Schedule Files to Determine Date
Replies
1
Views
158
sijpie
sijpie
H
  • Question Question
Copy Data where Source Workbook contains Name that is in destination sheet
Replies
4
Views
75
howard
H
P
  • Question Question
VBA to import multilpe xml files
Replies
1
Views
765
PippaThePointer
P

Forum statistics

Threads
1,223,889
Messages
6,175,226
Members
452,620
Latest member
dsubash

Share this page

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