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
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