I have some code that I have used many times to prompt to open up a file, but this time I don't want it to prompt me if the file is already open as I will be using the file multiple times within the same macro. The first code block is the above mentioned prompt, the second code block is the macro in its entirety (just in case). Some of the below code was used from http://www.rondebruin.nl/ so thanks to him for his work!
'to prompt open appropriate Fresh and Frozen Receivings workbook
Set thisbook = ActiveWorkbook
MsgBox "Open appropriate Fresh and Frozen Receivings file in the" & Chr(13) & """\\MAMMOTH\AcctDocs\Inventory\""Year""\""Plant""\""Month"""" Directory.", vbExclamation, "Select File..."
ChDir "\\MAMMOTH\AcctDocs\Inventory\"
FileToOpen = Application.GetOpenFilename _
(Title:="Please the appropriate month's file to import", _
FileFilter:="Excel Files *.xls;*.xlsx ,*.xls;*.xlsx")
If FileToOpen = False Then
MsgBox "No file selected...Please try again" & Chr(13) & "Open appropriate Fresh and Frozen Receivings file in the" & Chr(13) & """\\MAMMOTH\AcctDocs\Inventory\""Year""\""Plant""\""Month"""" Plant Production\Parity Pivot Tables\"" Directory.", vbExclamation, "No file Selected...Select File..."
ChDir "\\MAMMOTH\AcctDocs\Inventory\"
FileToOpen = Application.GetOpenFilename _
(Title:="Please the appropriate month's file to import", _
FileFilter:="Excel Files *.xls;*.xlsx ,*.xls;*.xlsx")
End If
If FileToOpen = False Then
MsgBox "Failed to select Parity-MAS Pivot Table file" & Chr(13) & "Macro ended before finishing. Delete the all tabs except the ""Download"" tab and re-run production tab macro again.", vbExclamation, "Failed..."
Exit Sub
Else
Workbooks.Open Filename:=FileToOpen
End If
Sub MAS_to_Parity_VarTab_addMASCost()
'this macro adds in the MAS Cost formula to the MAS to Parity Variance tab in the Month End Production workbook
Plant = Left(ActiveWorkbook.Name, 3)
Sheets("" & Plant & " Frozen Receivings").Select
Call addMASCost
Sheets("" & Plant & " Frozen Receivings").Select
Call addMASCost
End Sub
'___________________________________________
Sub addMASCost()
'to prompt open appropriate Fresh and Frozen Receivings workbook
Set thisbook = ActiveWorkbook
MsgBox "Open appropriate Fresh and Frozen Receivings file in the" & Chr(13) & """\\MAMMOTH\AcctDocs\Inventory\""Year""\""Plant""\""Month"""" Directory.", vbExclamation, "Select File..."
ChDir "\\MAMMOTH\AcctDocs\Inventory\"
FileToOpen = Application.GetOpenFilename _
(Title:="Please the appropriate month's file to import", _
FileFilter:="Excel Files *.xls;*.xlsx ,*.xls;*.xlsx")
If FileToOpen = False Then
MsgBox "No file selected...Please try again" & Chr(13) & "Open appropriate Fresh and Frozen Receivings file in the" & Chr(13) & """\\MAMMOTH\AcctDocs\Inventory\""Year""\""Plant""\""Month"""" Plant Production\Parity Pivot Tables\"" Directory.", vbExclamation, "No file Selected...Select File..."
ChDir "\\MAMMOTH\AcctDocs\Inventory\"
FileToOpen = Application.GetOpenFilename _
(Title:="Please the appropriate month's file to import", _
FileFilter:="Excel Files *.xls;*.xlsx ,*.xls;*.xlsx")
End If
If FileToOpen = False Then
MsgBox "Failed to select Parity-MAS Pivot Table file" & Chr(13) & "Macro ended before finishing. Delete the all tabs except the ""Download"" tab and re-run production tab macro again.", vbExclamation, "Failed..."
Exit Sub
Else
Workbooks.Open Filename:=FileToOpen
End If
Receivings = ActiveWorkbook.Name
'to add name ranges to the Fresh and Frozen Receivings Workbook
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'We use the ActiveSheet but you can replace this with
'Sheets("MySheet")if you want
With ActiveSheet
'We select the sheet so we can change the window view
.Select
'If you are in Page Break Preview Or Page Layout view go
'back to normal view, we do this for speed
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
'Turn off Page Breaks, we do this for speed
.DisplayPageBreaks = False
'Set the first and last row to loop through
Firstrow = .UsedRange.Cells(1).Row
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
'We loop from Lastrow to Firstrow (bottom to top)
For Lrow = Lastrow To Firstrow Step -1
'We check the values in the A column in this example
With .Cells(Lrow, "D")
If Not IsError(.Value) Then
'to name vlookup range
If .Value Like "*Fresh*" Then Range(Range("D" & Lrow).Offset(1, -2), Range("L" & Lrow).Offset(1).End(xlDown).Offset(-1)).Name = "FreshRecs"
If .Value Like "*Frozen*" Then Range(Range("D" & Lrow).Offset(1, -2), Range("L" & Lrow).Offset(1).End(xlDown).Offset(-1)).Name = "FrozenRecs"
If .Value Like "*Fresh*" Then Range(Range("A" & Lrow).Offset(1), Range("A" & Lrow).Offset(1).End(xlDown)).Offset(0, 1).FormulaR1C1 = "=RC[-1]&"" ""&""Total"""
If .Value Like "*Frozen*" Then Range(Range("A" & Lrow).Offset(1), Range("A" & Lrow).Offset(1).End(xlDown)).Offset(0, 1).FormulaR1C1 = "=RC[-1]&"" ""&""Total"""
End If
End With
Next Lrow
End With
ActiveWindow.WindowState = xlMinimized
ActiveWindow.WindowState = xlMaximized
'to add vlookup formula
'We use the ActiveSheet but you can replace this with
'Sheets("MySheet")if you want
With ActiveSheet
'We select the sheet so we can change the window view
.Select
'If you are in Page Break Preview Or Page Layout view go
'back to normal view, we do this for speed
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
'Turn off Page Breaks, we do this for speed
.DisplayPageBreaks = False
'Set the first and last row to loop through
Firstrow = .UsedRange.Cells(1).Row
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
'We loop from Lastrow to Firstrow (bottom to top)
For Lrow = Lastrow To Firstrow Step -1
'We check the values in the A column in this example
With .Cells(Lrow, "N")
If Not IsError(.Value) Then
If .Value Like "*Total" Then
Range("AA" & Lrow).Select
Selection.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-13],'" & Receivings & "'!FrozenRecs,11,false),0)"
End If
End If
End With
Next Lrow
End With
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub
Bookmarks