Sub Pre_Plan()
'***********************************************************************************
'
' Pre_Plan Macro
' This will ask for the files that are needed to pre plan, and then will pre plan for you
'
' Keyboard Shortcut: Ctrl+g
'
' V1.2
'
'***********************************************************************************
' MsgBox Notes:
'***********************************************************************************
'
' Type of Buttons: Potential Return Responses:
' 1 vbOKOnly vbOK
' 2 vbOKCancel vbOK, vbCancel
' 3 vbAbortRetryIgnore vbAbort, vbRetry, vbIgnore
' 4 vbYesNoCancel vbYes, vbNo, vbCancel
' 5 vbYesNo vbYes, vbNo
' 6 vbRetryCancel vbRetry, vbCancel
'
'***********************************************************************************
'
Dim Current_Week_File_Name As String
Dim DisplayMsg As String
Dim Original_Current_Week_File_Name As String
Dim SaveToWorkBook As String
Dim Start_Row_of_Data As Integer
Dim VerifyRequest As Integer
Dim VerifyRequestHeader As String
'
'***********************************************************************************
Display_Opening_Prompt:
'***********************************************************************************
'
' Message Title displayed to viewer
VerifyRequestHeader = "You are about to Pre-plan the "
VerifyRequestHeader = VerifyRequestHeader & "'Student/Adult Portions "
VerifyRequestHeader = VerifyRequestHeader & "Planned' Columns. IE. (E & F)!"
'
' Additional Message displayed to viewer
DisplayedMsg = "This will perform your Pre-planning for you, for the entire week."
'
' Display the Entire MessageBox to the viewer with options
VerifyRequest = MsgBox(DisplayedMsg, vbOKCancel, VerifyRequestHeader)
'
' Check which button was pressed
If VerifyRequest = vbCancel Then ' If they chose to cancel, then ...
Exit Sub ' Exit Pre-Planning
End If
' ' Otherwise ....
'***********************************************************************************
Get_Current_Week_File_Name:
'***********************************************************************************
'
' Show the 'Open' window and pass the selected file name to
' the String variable named "Current_Week_File_Name"
Current_Week_File_Name = Application.GetOpenFilename _
("Excel Files (*.xl*), *.xl*,All Files(*.*),*.*", 1, _
"Select Current week file. !!! FYI !!! Hold 'alt' key and press 'arrow up' key one time to go up one folder")
'
' Check if User still wants to continue with request
If Current_Week_File_Name = "False" Then ' Request was cancelled
MsgBox "Cancelled 'Pre Plan' request." ' Display cancelled message
Exit Sub ' Exit Pre-Planning
End If
'
' A 'Copy from' file name/location has been selected.
'
' Because Windows7 is stupid ...
' Check to see if the file extention is included in the file name.
' If it isn't, then add it to the end of the file name.
If Mid(Current_Week_File_Name, Len(Current_Week_File_Name) - 3, 1) <> "." And _
Mid(Current_Week_File_Name, Len(Current_Week_File_Name) - 4, 1) <> "." Then
FileExtention = InputBox(Prompt:="Please enter the file extention type for this file.", _
Title:="Warning! File extention Missing ... xlsx, txt, zip, etc", _
Default:="xlsx")
Current_Week_File_Name = Current_Week_File_Name & "." & FileExtention
End If
'
' Test to see if the file to be 'copied from' is already open.
If IsFileOpen(Current_Week_File_Name) Then ' If File is already opened then ...
GoTo Get_Original_Current_Week_File_Name: ' Go ask user for the original file
Else ' Else, if File is not open yet ...
' If we land here, then the file that they want to get 'pre plan' numbers from is not open yet.
Workbooks.Open (Current_Week_File_Name) ' Open the file
'
' Save just the workbook name and extention into Current_Week_File_Name
Current_Week_File_Name = ActiveWorkbook.Name
End If
'
'_____________________________________________________________________________________
'***********************************************************************************
Get_Original_Current_Week_File_Name:
'***********************************************************************************
'
' Show the 'Open' window and pass the selected file name to
' the String variable named "Original_Current_Week_File_Name"
Original_Current_Week_File_Name = Application.GetOpenFilename _
("Excel Files (*.xl*), *.xl*,All Files(*.*),*.*", 1, _
"Select Original Current Week File Name. !!! FYI !!! Hold 'alt' key and press 'arrow up' key one time to go up one folder")
'
' Check if User still wants to continue with request
If Original_Current_Week_File_Name = "False" Then ' Request was cancelled
MsgBox "Cancelled 'Pre Plan' request." ' Display cancelled message
Exit Sub ' Exit Pre-Planning
End If
'
' A 'Copy to' file name/location has been selected.
'
' Because Windows7 is stupid ...
' Check to see if the file extention is included in the file name.
' If it isn't, then add it to the end of the file name.
If Mid(Original_Current_Week_File_Name, Len(Original_Current_Week_File_Name) - 3, 1) <> "." And _
Mid(Original_Current_Week_File_Name, Len(Original_Current_Week_File_Name) - 4, 1) <> "." Then
FileExtention = InputBox(Prompt:="Please enter the file extention type for this file.", _
Title:="Warning! File extention Missing ... xlsx, txt, zip, etc", _
Default:="xlsx")
Original_Current_Week_File_Name = Original_Current_Week_File_Name & "." & FileExtention
End If
'
' Test to see if the file to be 'copied to' is already open.
If IsFileOpen(Original_Current_Week_File_Name) Then ' If File is already opened then ...
GoTo Get_Worksheet_Name: ' continue on to formulas
'
Else ' Else, if File is not open yet ...
' If we land here then the file that they want to put 'pre plan' numbers into is not open yet.
Workbooks.Open (Original_Current_Week_File_Name) ' Open the file
'
' Save just the workbook name and extention into Original_Current_Week_File_Name
Original_Current_Week_File_Name = ActiveWorkbook.Name
End If
'
'_____________________________________________________________________________________
'
' We don't need this anymore because we are gonna use the macro to write the formulas for us.
'
' Save the file name chosen for the current week file into a cell in our original
' file chosen so we can use it in our preplanning formulas.
' With Workbooks(SaveToWorkBook)
' .Sheets(12).Range("A2") = Current_Week_File_Name
' End With
'
'***********************************************************************************
Get_Worksheet_Name:
'***********************************************************************************
With Workbooks(Original_Current_Week_File_Name)
' Set up loop to go through first 5 sheets of the workbook
For Sheet_Counter = 1 To 5
'
'get corresponding sheet name from Current_Week_File_Name
Current_Week_Sheet_Name = Workbooks(Current_Week_File_Name) _
.Sheets(Sheet_Counter).Name
'
'***********************************************************************************
Find_Starting_Row_of_Data:
'***********************************************************************************
For Each Cell In .Sheets(Sheet_Counter).Range("A1:A60")
' Check 'A' column for Left part of string = "PLANNING"
If Left(Cell.Value, 8) = "PLANNING" Then ' If found then ...
Start_Row_of_Data = Cell.Row + 5 ' Our data starts 5 rows down from this
GoTo Find_Ending_Row_of_Data:
End If
Next Cell ' go check next cell in range for our 'flag'
'
' Warning !!! Our 'flag' was not found ... Something is not right.
MsgBox "Could not find the start of the data section. Program terminated!"
Exit Sub
'
'***********************************************************************************
Find_Ending_Row_of_Data:
'***********************************************************************************
For Each Cell In .Sheets(Sheet_Counter).Range("A1:A60")
' Check 'A' column for Left part of string = "Leftover"
If Left(Cell.Value, 8) = "Leftover" Then ' If found then ...
Ending_Row_of_Data = Cell.Row - 1 ' Our data ends on this line
GoTo Write_Formulas
End If
Next Cell ' go check next cell in range for our 'flag'
'
' Warning !!! Our 'flag' was not found ... Something is not right.
MsgBox "Could not find the end of the data section. Program terminated!"
Exit Sub
'
'***********************************************************************************
Write_Formulas:
'***********************************************************************************
For Each Cell In .Sheets(Sheet_Counter).Range("E" & Start_Row_of_Data & ":F" & Ending_Row_of_Data)
If Cell.HasFormula = False And _
WorksheetFunction.IsNumber(Cell.Value) Then
Cell.Interior.Color = vbGreen 'use this cell
Cell.FormulaR1C1 = _
"='[" & Current_Week_File_Name & "]" & _
Current_Week_Sheet_Name & "'!" & "RC[12] + " & Cell.Value
ElseIf Cell.HasFormula = True Then
Cell.Interior.Color = vbRed 'skip this cell
End If
Next Cell
Next Sheet_Counter
End With
'***********************************************************************************
Delete_Formulas_From_Pre_Planning:
'***********************************************************************************
'
' Save just the workbook name from the entire path name
' SaveToWorkBook = ExtractFileName(Original_Current_Week_File_Name)
'' SaveToWorkBook = Original_Current_Week_File_Name
'
' Set it as the active workbook
' Workbooks("Cycle B Elementary Lunch Production Record.xlsx").Worksheets("Cycle B Day 1").Activate ' No longer Needed
' Workbooks(SaveToWorkBook).Worksheets(1).Activate ' Worksheets(x) = which worksheet
Workbooks(Original_Current_Week_File_Name).Worksheets(1).Activate ' Worksheets(x) = which worksheet
'
Dim Loop_Counter As Integer
'
' Set up loop to go through all 5 workdays of the week ... first 5 sheets in the workbook
For Loop_Counter = 1 To 5 ' Sheets.Count ... would = all sheets ;)
Sheets(Loop_Counter).Select
'
' highlight range to delete formulas from
Range("E13:F50").Select
'
' Delete formulas from the selected range of cells
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Next Loop_Counter ' Loop back to beginning of this loop until finished
'
MsgBox "Congratulations!!! Your Pre Planning has been done for you !!!" & vbCr & vbCr & "Now designate where you want to save/Rename this resulting file." & vbCr & vbCr & "Hint: 'pre planning' folder ;)"
'
' Ask the user where and what to save the file as
FileSaveName = Application.GetSaveAsFilename( _
fileFilter:="Microsoft Office Excel Workbook (*.xlsx), *.xlsx")
If FileSaveName = False Then End
ActiveWorkbook.SaveAs Filename:=FileSaveName
' Else ' They chose to cancel
' Exit Sub ' Exit Pre-Planning
' End If
End Sub
'***********************************************************************************
Function IsFileOpen(FullPathFileName As String) As Boolean
'***********************************************************************************
'
Dim Filenum As Long
'
' An Error is generated if you try opening a File for ReadWrite lock
' when it is already open!
On Error GoTo FileIsOpen: ' If Error occurrs, then file is already open
'
Filenum = FreeFile ' Get a free file number
Open FullPathFileName For Random Access Read Write _
Lock Read Write As Filenum
'
' If we make it to here, then No error occurred, File was not already open
IsFileOpen = False ' Set this function result to 'False'
Close Filenum ' Close the file
On Error GoTo 0 ' Turn off Error handling
Exit Function
'
' If we land here, an error occurred because the file is already open
FileIsOpen:
IsFileOpen = True ' Set this function result to 'True'
Err.Clear ' Clear Error
Close Filenum ' Close the file
On Error GoTo 0 ' Turn off Error handling
End Function
After it is saved into a cell in the second workbook, I want to use that cell value, ie. the first workbook name, to load a cell value from that first workbook name/sheet into the second workbook selected/sheet. Sheet names might vary between the workbooks, but the order of the sheets should be presumed to be in the same order. So basically both workbooks are arranged in the same order sheet wise, as well as the rows and columns.
Wow...you've been busy. 
