Consulting

Results 1 to 19 of 19

Thread: Solved: automatically select 'Don't Save' if message box pop up

  1. #1

    Solved: automatically select 'Don't Save' if message box pop up

    How to automatically select 'Don't Save' if message box pop up?
    I'm using office 2010 version.

    [vba]If scno <> 1 Then
    MsgBox "The computer will again ask you if you want to save some workbooks. Do not save these workbooks. Simply select 'no' each time it asks."
    End If[/vba]

  2. #2
    Knowledge Base Approver VBAX Guru GTO's Avatar
    Joined
    Sep 2008
    Posts
    3,368
    Location
    Hi Halimi,

    Could you show us a wee bit more of your code? I would think that chances are, you should be able to suppress alerts or close the files w/o saving.

  3. #3
    Hi GTO,


    [VBA]Sub RunHSC()
    ' Turn calculations off:
    With Application
    .Calculation = xlManual
    .MaxIterations = 150
    .MaxChange = 0.001
    .Iteration = False
    End With
    ' reading scenario number and model path
    Windows("HSC_Scenarios.xlsm").Activate
    Sheets("HRDsystem").Activate
    Range("C5").Select
    Set scno = Worksheets("HRDsystem").Cells(5, 3)
    Set scnotext = Worksheets("HRDsystem").Cells(23, 3)
    Set pathname = Worksheets("HRDsystem").Cells(23, 1)
    '
    'Open first set of HRD model workbooks:
    '
    ChDir pathname + "\HDM model"
    Workbooks.Open Filename:= _
    pathname + "\HDM model\HDM.xlsx", UpdateLinks:=0
    ChDir pathname + "\HEM model"
    Workbooks.Open Filename:= _
    pathname + "\HEM model\HEM_citizens.xlsx", UpdateLinks:=0
    Workbooks.Open Filename:= _
    pathname + "\HEM model\HEM_non_citizens.xlsx", UpdateLinks:=0
    Workbooks.Open Filename:= _
    pathname + "\HEM model\SS DD Link.xlsx", UpdateLinks:=0
    '
    'Open macro model workbooks:
    '
    ChDir pathname + "\HMM model"
    Workbooks.Open Filename:= _
    pathname + "\HMM model\sim.xlsm", UpdateLinks:=0
    '
    ' Turn calculations on:
    '
    With Application
    .Calculation = xlAutomatic
    .MaxIterations = 150
    .MaxChange = 0.001
    .Iteration = True
    End With
    Calculate
    '
    ' Close the first set of HRD model workbooks
    '
    MsgBox "The computer will now ask you if you want to save some workbooks. Do not save these workbooks. Simply select 'no' each time it asks."
    Windows("SS DD Link.xlsx").Activate
    ActiveWindow.Close
    Windows("HEM_citizens.xlsx").Activate
    ActiveWindow.Close
    Windows("HEM_non_citizens.xlsx").Activate
    ActiveWindow.Close
    Windows("HDM.xlsx").Activate
    ActiveWindow.Close
    '
    ' Run Macro Model - sim.xls
    '
    Windows("sim.xlsm").Activate
    Sheets("in").Select
    Application.Run "sim.xlsm!Run_Forecast"
    '
    ' Open all HRD model workbooks
    '
    ActiveWorkbook.PrecisionAsDisplayed = False
    ChDir pathname + "\HMM model"
    Workbooks.Open Filename:= _
    pathname + "\HMM model\industry satellite.xlsx", UpdateLinks:=0
    ChDir pathname + "\HODM model"
    Workbooks.Open Filename:= _
    pathname + "\HODM model\occshares.xlsm", UpdateLinks:=0
    Workbooks.Open Filename:= _
    pathname + "\HODM model\empbyocc_doctomasco.xlsx", UpdateLinks:=0
    ChDir pathname + "\HDM model"
    Workbooks.Open Filename:= _
    pathname + "\HDM model\HDM.xlsx", UpdateLinks:=0
    ChDir pathname + "\HEM model"
    Workbooks.Open Filename:= _
    pathname + "\HEM model\HEM_citizens.xlsx", UpdateLinks:=0
    Workbooks.Open Filename:= _
    pathname + "\HEM model\HEM_non_citizens.xlsx", UpdateLinks:=0
    Workbooks.Open Filename:= _
    pathname + "\HEM model\SS DD Link.xlsx", UpdateLinks:=0
    ChDir pathname + "\HOSM model"
    Workbooks.Open Filename:= _
    pathname + "\HOSM model\HOSM_citizen.xlsm", UpdateLinks:=0
    Workbooks.Open Filename:= _
    pathname + "\HOSM model\HOSM_noncitizen.xlsm", UpdateLinks:=0
    ChDir pathname + "\HODM model"
    Workbooks.Open Filename:= _
    pathname + "\HODM model\occdem.xlsx", UpdateLinks:=0
    '
    ' Open HRD basecase workbook
    '
    ChDir pathname + "\HRD SYSTEM CONTROL"
    Workbooks.Open Filename:= _
    pathname + "\HRD SYSTEM CONTROL\HRD outputs_base.xlsx", UpdateLinks:=0
    ' Open other scenario workbooks if not running the basecase
    If scno <> 1 Then
    Workbooks.Open Filename:= _
    pathname + "\HRD SYSTEM CONTROL\HRD outputs_sim2.xlsx", UpdateLinks:=0
    Workbooks.Open Filename:= _
    pathname + "\HRD SYSTEM CONTROL\HRD deviations2.xlsx", UpdateLinks:=0
    '
    ' Set the number of the scenario equal to the active scenario so that the results are collected
    ' in the outputs sheet
    '
    Windows("HRD outputs_sim2.xlsx").Activate
    Sheets("Scenario").Activate
    Range("A4").Select
    ActiveCell.FormulaR1C1 = scno
    End If
    ' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    ' :=False, Transpose:=False
    '
    ' Press "Calculate" button 10 times:
    '
    ' Dim Check, Counter
    ' Check = True: Counter = 0 ' Initialize variables.
    ' Do ' Outer loop.
    ' Do While Counter < 11 ' Inner loop.
    ' '
    ' ' Turn calculations on:
    ' '
    ' With Application
    ' .Calculation = xlAutomatic
    ' .MaxIterations = 100
    ' .MaxChange = 0.001
    ' End With
    ' '
    ' Counter = Counter + 1 ' Increment Counter.
    Calculate
    ' If Counter = 10 Then ' If condition is True.
    ' Check = False ' Set value of flag to False.
    ' Exit Do ' Exit inner loop.
    ' End If
    ' Loop
    ' Loop Until Check = False ' Exit outer loop
    '
    ' Close the second set of HRD model workbooks
    '
    If scno <> 1 Then
    MsgBox "The computer will again ask you if you want to save some workbooks. Do not save these workbooks. Simply select 'no' each time it asks."
    End If
    ' MsgBox "The computer will again ask you if you want to save some workbooks. This time only save these workbooks if you are running the basecase scenario (scenario 1)."
    ' MsgBox "That is, if you are running the basecase, select 'yes' each time the computer asks you if you would like to save the workbooks. If you are not running the basecase, simply select 'no' each time it asks."
    ' if this is the basecase, save changes to the basecase
    If scno = 1 Then
    Windows("HRD outputs_base.xlsx").Activate
    ActiveWorkbook.Save
    End If
    Windows("industry satellite.xlsx").Activate
    If scno = 1 Then
    ActiveWorkbook.Save
    End If
    ActiveWindow.Close
    Windows("sim.xlsm").Activate
    If scno = 1 Then
    ActiveWorkbook.Save
    End If
    ActiveWindow.Close
    Windows("HEM_citizens.xlsx").Activate
    If scno = 1 Then
    ActiveWorkbook.Save
    End If
    ActiveWindow.Close
    Windows("HEM_non_citizens.xlsx").Activate
    If scno = 1 Then
    ActiveWorkbook.Save
    End If
    ActiveWindow.Close
    Windows("HDM.xlsx").Activate
    If scno = 1 Then
    ActiveWorkbook.Save
    End If
    ActiveWindow.Close
    Windows("SS DD Link.xlsx").Activate
    If scno = 1 Then
    ActiveWorkbook.Save
    End If
    ActiveWindow.Close
    Windows("empbyocc_doctomasco.xlsx").Activate
    If scno = 1 Then
    ActiveWorkbook.Save
    End If
    ActiveWindow.Close
    Windows("occshares.xlsm").Activate
    If scno = 1 Then
    ActiveWorkbook.Save
    End If
    ActiveWindow.Close
    '
    'Open final set of HRD model workbooks:
    '
    ChDir pathname + "\HRD extensions"
    Workbooks.Open Filename:= _
    pathname + "\HRD extensions\4digitOcc.xlsx", UpdateLinks:=0
    ChDir pathname + "\HBF facility"
    Workbooks.Open Filename:= _
    pathname + "\HBF facility\HBF_outputs.xlsx", UpdateLinks:=0
    Calculate
    '
    ' Reduce number of iterations:
    '
    With Application
    .Calculation = xlAutomatic
    .MaxIterations = 10
    .MaxChange = 0.001
    .Iteration = True
    End With
    '
    ' Close all remaining workbooks except the "scenarios", "output" and "deviation" workbooks
    '
    ' MsgBox "The computer will again ask you if you want to save some workbooks. Again, you should only save these workbooks if you are running the basecase scenario (scenario 1)."
    If scno <> 1 Then
    MsgBox "The computer will again ask you if you want to save some workbooks. Do not save these workbooks. Simply select 'no' each time it asks."
    End If
    ' if running the basecase, saves the basecase
    If scno = 1 Then
    Windows("HRD outputs_base.xlsx").Activate
    ActiveWorkbook.Save
    End If
    Windows("HBF_outputs.xlsx").Activate
    If scno = 1 Then
    ActiveWorkbook.Save
    End If
    ActiveWindow.Close
    Windows("4digitOcc.xlsx").Activate
    If scno = 1 Then
    ActiveWorkbook.Save
    End If
    ActiveWindow.Close
    Windows("HOSM_citizen.xlsm").Activate
    If scno = 1 Then
    ActiveWorkbook.Save
    End If
    ActiveWindow.Close
    Windows("HOSM_noncitizen.xlsm").Activate
    If scno = 1 Then
    ActiveWorkbook.Save
    End If
    ActiveWindow.Close
    Windows("occdem.xlsx").Activate
    If scno = 1 Then
    ActiveWorkbook.Save
    End If
    ActiveWindow.Close
    ' save scenarios
    ' if running the basecase, saves the basecase, otherwises closes it
    If scno = 1 Then
    Windows("HSC_Scenarios.xlsm").Activate
    ActiveWorkbook.Save
    Windows("HRD outputs_base.xlsx").Activate
    ActiveWorkbook.Save
    MsgBox "Basecase successfully run!"
    End If
    If scno <> 1 Then
    Windows("HRD outputs_base.xlsx").Activate
    ActiveWindow.Close
    Windows("HSC_Scenarios.xlsm").Activate
    ActiveWorkbook.Save
    End If
    '
    ' if running alternative scenario, saves the "sim" and "deviation" workbooks

    If scno <> 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 scno <> 1 Then
    Windows("HRD outputs_sim2.xlsx").Activate
    Windows("HRD deviations2.xlsx").Activate
    Windows("HRD outputs_sim2.xlsx").Activate
    ActiveWorkbook.SaveAs Filename:= _
    pathname + "\HRD SYSTEM CONTROL\HRD outputs_sim" + scnotext + ".xlsx" _
    , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Windows("HRD deviations2.xlsx").Activate
    ActiveWorkbook.SaveAs Filename:= _
    pathname + "\HRD SYSTEM CONTROL\HRD deviations" + scnotext + ".xlsx" _
    , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    MsgBox "Scenario number " + scnotext + " successfully run!"
    End If
    End Sub[/VBA]

  4. #4
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,728
    Location
    Cleanest way I know is to do something like

    [vba]
    Workbooks("HOSM_citizen.xlsm").Close (false)
    [/vba]


    That would just close the workbook without asking


    Paul

  5. #5
    any global code for this one, because a lots of sheet opened durig process

  6. #6
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    As I have recommended before, always use Option Explicit. Notice that the DIMensioned variable names have a prefix that gives you a clue to know what type of variable that they were defined as.

    My rule of thumb to use a For loop or Select Case structure is when I have 3 or more items to process. In this case, I show you how to use an array to store data. I have not tested this but it is close to a working example. Start this kind of thing simply and test often.

    Use "&" for string concatenation rather than "+".

    We may need to parse the filename from the fullname in the array. This is easily done. This code is just an example to show you the concepts that I talked about. If you understand the concepts, you can fix your code. Lots of code with items that we can not easily test is less likely to receive an exact solution.
    [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, sScnotext As String, sPathname 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

    'Open first set of HRD model workbooks:
    ReDim wbArray(1 To 4)
    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"
    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(wbArray(i)).Close (False)
    Next i

    Set ws = Nothing
    Set wb = Nothing
    Set rScno = Nothing
    Set rScnotext = Nothing
    Set rPathname = Nothing
    End Sub[/vba]

  7. #7
    Thanks sir, I'll try first and made some adjustment base on how my model structure works.

  8. #8
    Hi Sir,

    why i got error in this line:

    If iScno <> 1 Then Workbooks(wbArray(i)).Close (False)

  9. #9
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    I am not there so I would have to guess. Maybe the file was not open? If you step through debug with F8, is the value what you expected?

    Maybe it needs just the filename as I explained earlier?

    [VBA]Sub RunHSC_Ken()
    Dim s As String, i As Integer
    Dim rScno As Range, rScnotext As Range, rPathname As Range
    Dim iScno As Integer, sScnotext As String, sPathname 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

    'Open first set of HRD model workbooks:
    ReDim wbArray(1 To 4)
    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"
    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
    End Sub

    Function GetFileName(filespec As String)
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    GetFileName = fso.GetFileName(filespec)
    Set fso = Nothing
    End Function

    [/VBA]

  10. #10
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,728
    Location
    Probably just need 'Call'

    [VBA]
    If iScno <> 1 Then Call Workbooks(wbArray(i)).Close (False)
    [/VBA]


    Paul

  11. #11
    Thanks Paul, hopefully it will work

  12. #12
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    Besides Call, you can do it like this:
    [VBA]If iScno <> 1 Then Workbooks(GetFileName(wbArray(i))).Close , False[/VBA]

  13. #13
    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]

  14. #14
    here is my file directory:
    D:\My Model\CGE\Projects\2011 HRD update\model

  15. #15
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    There is no reason to run code if it will not compile. I most always compile first. Since I did not have your files, I did not test as much as I usually do.

    For the array deal, there was a name collision so I just renamed my function. After this code, read what follows.

    [vba]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) As String
    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 (CStr(wbArray(i))), UpdateLinks:=False
    Next i

    'Close without saving.
    For i = 1 To UBound(wbArray)
    s = fGetFileName(wbArray(i))
    If iScno <> 1 Then Workbooks(s).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(fGetFileName(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(fGetFileName(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

    Function fGetFileName(filespec As String) As String
    Dim fso As Object, s As String
    Set fso = CreateObject("Scripting.FileSystemObject")
    s = fso.GetFileName(filespec)
    Set fso = Nothing
    fGetFileName = s
    End Function
    [/vba]
    Since I did not have your files, I can not test the code in full. Obviously, my run would error with this line since the file is not open.
    [vba] Set wb = Workbooks("HSC_Scenarios.xlsm")[/vba]
    Before opening, closing, or setting an object variable for workbooks, this routine can make your life easier.

    [vba]Function IsWorkbookOpen(stName As String) As Boolean
    Dim Wkb As Workbook
    On Error Resume Next ' In Case it isn't Open
    Set Wkb = Workbooks(stName)
    If Not Wkb Is Nothing Then IsWorkbookOpen = True
    'Boolean Function assumed To be False unless Set To True
    End Function[/vba]

  16. #16
    Hi Kenneth Hobs,

    Pls drop me an email so that I can email my file.

    halimi.taifor@gmail.com
    Last edited by halimi1306; 08-12-2011 at 02:40 PM.

  17. #17
    Mac Moderator VBAX Guru mikerickson's Avatar
    Joined
    May 2007
    Location
    Davis CA
    Posts
    2,778
    How about something like
    [vba]Dim UserWantsSave as Boolean
    ' ...
    UserWantsSave = (MsgBox("Save these closing workbooks?",vbYesNo) = vbYes)

    Workbooks("Workbook1.xls").Close SaveChanges:= UserWantsSave
    Workbooks("Workbook2.xls").Close SaveChanges:= UserWantsSave
    Workbooks("Workbook3.xls").Close SaveChanges:= UserWantsSave

    [/vba]

  18. #18
    Hi Mikericson,

    thanks

  19. #19
    Hi Kenneth Hobs and Mikericson,

    With combination of your code works very well. Thank you very much for your kind helps.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •