VBA Pulling data into sheet from closed workbooks

J

jamescooper

Well-known Member
Joined
Sep 8, 2014
Messages
834
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

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
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

H
  • Question
VBA split file based and send splitted file in separate emails
Replies
0
Views
228
harmless92
H
P
  • Question
VBA to import multilpe xml files
Replies
1
Views
149
PippaThePointer
P
K
  • Question
VBA Copy, Paste to Different Workbook, Save as then loop the action through slicer
Replies
1
Views
711
krisoey
K
R
  • Solved
combining csv workbooks to single sheet - vba works but need help adjusting
Replies
4
Views
467
Alex Blakenburg
A
J
  • Question
Cannot close temporary file and delete in VBA for Excel coding
Replies
2
Views
554
jolor69
J

Forum statistics

Threads
1,216,052
Messages
6,128,509
Members
449,455
Latest member
jesski

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