Dim newfile As String
Dim template As String
Dim wbx As Workbook
Dim wby As Workbook
Dim Month As String
Dim Entity
Dim underscore
Dim Hypname
Dim Fullnme
Dim Mnth
Dim Year
Dim Consolidation
Dim Response As Integer
Dim Snd
Dim Flder
Dim dte
Dim rsp
Dim ws As Worksheet
Dim I As Integer
Dim x As Long
Dim r As Long
Dim sh As Worksheet
r = 1
Application.DisplayAlerts = False
Application.ScreenUpdating = False
template = ActiveWorkbook.Name
'Change name of drop down to suit
With Worksheets("Data").DropDowns("Drop Down 17")
For x = 1 To .ListCount
.ListIndex = x
'calculates and refreshes open workbook
Sheets("TITLEPAGE").Activate
ActiveSheet.Calculate
Sheets("Data").Activate
ActiveSheet.Calculate
Sheets("Companies").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets(Array("Companies", "TITLEPAGE", "Data", "Assets", "Liabilities_Equity", _
"Income_Statement", "Intercompany", "Inventory", "PPE-MONTH", "Intangibles", _
"Headcount", "Debt", "Debt Worksheet", "Bonus", "Statistics", "Check")).Select
Calculate
'sets open workbook hyperion name and saves into send file
Mnth = Sheets("TITLEPAGE").Range("a52")
Year = Sheets("TITLEPAGE").Range("a53")
Consolidation = Sheets("TITLEPAGE").Range("a54")
Fldr = Sheets("TITLEPAGE").Range("a58")
Month = Mnth & " " & Year & " " & Consolidation
Entity = Sheets("TITLEPAGE").Range("A55")
underscore = Sheets("TITLEPAGE").Range("A56")
Hypname = Sheets("TITLEPAGE").Range("A57")
Snd = Sheets("TITLEPAGE").Range("a58")
dte = Sheets("TITLEPAGE").Range("a59")
Fullnme = Entity & underscore & Hypname & Snd & underscore & dte
newfile = Fullnme
Set wbx = ActiveWorkbook
ActiveWorkbook.Saveas Filename:="E:\Groups\Hyperion\Acterna\Corp\FY2004\" & Month & "\Packs to load\Send\" & Fullnme & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Windows(template).Activate
ActiveWindow.Close False
'Formats and copy and paste values so enduser can see values instead of Hyperion links
Sheets("TITLEPAGE").Visible = False
Sheets("Assets").Select
Range("D13:D124").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Liabilities_Equity").Select
Range("D12:D93").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Income_Statement").Select
Range("D12:D140").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Statistics").Select
Range("D17:D20").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D22:D27").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D33").Select
Range("D33:D35").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D39:D41").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Data").Select
'Protects all sheets so user cannot alter
rsp = Sheets("Data").Range("B112").Value
For I = 1 To Worksheets.Count
Application.ScreenUpdating = False
Worksheets(I).Protect rsp
Sheets("Data").Select
Sheets("data").unprotect rsp
Rows("111:117").Select
Selection.FormulaHidden = True
Selection.EntireRow.Hidden = True
Selection.Locked = True
Sheets("data").Protect rsp
Next
'formats inventory page so end user can enter data
Sheets("Inventory").Select
Sheets("Inventory").unprotect rsp
Sheets("Inventory").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowUsingPivotTables:=True
Sheets("Data").Select
Range("B2").Select
'Saves active workbook to be sent and opens up template to start for new entity and closes finished template
ActiveWorkbook.Save
Set wby = Workbooks.Open("E:\Groups\Hyperion\Acterna\Corp\FY2004\" & Month & "\Entity Pack Template.xls")
wbx.Close
r = r + 1
Next x
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End With
End Sub