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
 
Sort by date Sort by votes
I have figured it out! Didn't have one of the sheets set to "Forecast", silly me...seemed to work this time.

Thanks for all your help - will let you know if goes wrong again.
 
Upvote 0

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Done it!

Needed this line in 2nd macro:

Code: 
fileSpec = FD & "Revenue\" & myvalue3 & "\" & cellvalue1 & ""

Phew!

Thanks for your efforts my friend!
 
Upvote 0
jamescooper said:
How is the first one managing to pull the data then without me opening it? I sort of understand.
Click to expand...

I actually remembered after typing that that I had used it before on a closed workbook and posted the code i used that let me perform an index lookup on data in a closed workbook. I am guessing you have a format error or something but I don't know unless I am debugging your project. Check the code I pasted above, see if it helps you recognize what you need to edit on yours.
 
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,223
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