-
Hi Sir,
Both doesn't work. Call will return the error 9 and the GetFileName will return Compile Error: Expected Array
[vba]Option Explicit
Sub RunHSC_Ken()
Dim s As String, i As Integer
Dim rScno As Range, rScnotext As Range, rPathname As Range
Dim iScno As Integer, sScno As String, sScnotext As String, sPathname As String, GetFileName As String
Dim wb As Workbook, ws As Worksheet
Dim wbArray() As String
Set wb = Workbooks("HSC_Scenarios.xlsm")
Set ws = wb.Worksheets("HRDsystem")
Set rScno = ws.Range("C5")
Set rScnotext = ws.Range("C23")
Set rPathname = ws.Range("A23")
sScno = rScno.Text
sScnotext = rScnotext.Text
sPathname = rPathname.Text
Application.Calculation = xlManual
'Open first set of HRD model workbooks:
ReDim wbArray(1 To 5)
s = sPathname & "\HDM model\"
wbArray(1) = s & "HDM.xlsx"
s = sPathname & "\HEM model\"
wbArray(2) = s & "HEM_citizens.xlsx"
wbArray(3) = s & "HEM_non_citizens.xlsx"
wbArray(4) = s & "SS DD Link.xlsx"
'Open macro model workbooks:
s = sPathname & "\HMM model\"
wbArray(5) = s & "sim.xlsm"
Application.Calculation = xlAutomatic
For i = 1 To UBound(wbArray)
Workbooks.Open (wbArray(i)), UpdateLinks:=False
Next i
'Close without saving.
For i = 1 To UBound(wbArray)
If iScno <> 1 Then Workbooks(GetFileName(wbArray(i))).Close , False
Next i
Set ws = Nothing
Set wb = Nothing
Set rScno = Nothing
Set rScnotext = Nothing
Set rPathname = Nothing
' Run Macro Model - sim.xls
'
Windows("sim.xlsm").Activate
Sheets("in").Select
Application.Run "sim.xlsm!Run_Forecast"
'
' Open all HRD model workbooks
ReDim wbArray(1 To 11)
s = sPathname & "\HMM model\"
wbArray(1) = s & "industry satellite.xlsx"
s = sPathname & "\HODM model\"
wbArray(2) = s & "occshares.xlsm"
wbArray(3) = s & "occdem.xlsx"
wbArray(4) = s & "empbyocc_doctomasco.xlsx"
s = sPathname & "\HDM model\"
wbArray(5) = s & "HDM.xlsx"
s = sPathname & "\HEM model\"
wbArray(6) = s & "HEM_citizens.xlsx"
wbArray(7) = s & "HEM_non_citizens.xlsx"
wbArray(8) = s & "SS DD Link.xlsx"
s = sPathname & "\HOSM model\"
wbArray(9) = s & "HOSM_citizen.xlsm"
wbArray(10) = s & "HOSM_noncitizen.xlsm"
'Open HRD basecase workbook
s = sPathname & "\HRD SYSTEM CONTROL\"
wbArray(11) = s & "HRD outputs_base.xlsx"
For i = 1 To UBound(wbArray)
Workbooks.Open (wbArray(i)), UpdateLinks:=False
Next i
'Close without saving.
For i = 1 To UBound(wbArray)
If iScno <> 1 Then Workbooks(GetFileName(wbArray(i))).Close , False
Next i
Set ws = Nothing
Set wb = Nothing
Set rScno = Nothing
Set rScnotext = Nothing
Set rPathname = Nothing
'Open final set of HRD model workbooks:
ReDim wbArray(1 To 2)
s = sPathname & "\HRD extensions\"
wbArray(1) = s & "4digitOcc.xlsx"
s = sPathname & "\HBF facility\"
wbArray(2) = s & "HBF_outputs.xlsx"
With Application
.Calculation = xlAutomatic
.MaxIterations = 10
.MaxChange = 0.001
.Iteration = True
End With
For i = 1 To UBound(wbArray)
Workbooks.Open (wbArray(i)), UpdateLinks:=False
Next i
'Close without saving.
For i = 1 To UBound(wbArray)
If iScno <> 1 Then Workbooks(GetFileName(wbArray(i))).Close , False
Next i
Set ws = Nothing
Set wb = Nothing
Set rScno = Nothing
Set rScnotext = Nothing
Set rPathname = Nothing
' if running alternative scenario, saves the "sim" and "deviation" workbooks
If iScno <> 1 Then
MsgBox "The computer will again ask you if you want to save some workbooks. Simply select 'yes' each time it asks."
End If
If iScno <> 1 Then
Windows("HRD outputs_sim2.xlsx").Activate
Windows("HRD deviations2.xlsx").Activate
Windows("HRD outputs_sim2.xlsx").Activate
ActiveWorkbook.SaveAs Filename:= _
sPathname & "\HRD SYSTEM CONTROL\HRD outputs_sim" & rScnotext & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Windows("HRD deviations2.xlsx").Activate
ActiveWorkbook.SaveAs Filename:= _
sPathname & "\HRD SYSTEM CONTROL\HRD deviations" & rScnotext & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
MsgBox "Scenario number " & rScnotext & " successfully run!"
End If
End Sub[/vba]
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules