'Module:        ComFDC
'Purpose:       Common FDC functions
'VB Version:    Excel 97 SR-1
'Written by:    David Crawford
'
Option Base 1
Option Explicit

Declare Function FADBGetDatabaseAlias Lib "FADBOB32.DLL" (ByVal nProduct%, ByVal sDatabaseAlias$) As Long
Declare Function LoadHistoryData Lib "FANDLG32.DLL" ( _
    ByVal Product As Integer, _
    ByVal hWnd As Long, _
    ByVal HistoryFileName As String, _
    ByVal FromPeriod As String, _
    ByVal FromYear As String, _
    ByVal ToPeriod As String, _
    ByVal ToYear As String, _
    ByVal OverWrite As String) As Long
Declare Function UnloadHistory Lib "FANDLG32.DLL" ( _
    ByVal Product As Integer, _
    ByVal hWnd As Long, _
    ByVal HistoryFile As String, _
    ByVal OverWrite As String, _
    ByVal SchedOrPkg As String, _
    ByVal UnitId As String, _
    ByVal Category As String, _
    ByVal LevelDepth As String, _
    ByVal FromPeriod As String, _
    ByVal ToPeriod As String, _
    ByVal Year As String, _
    ByVal ReportFile As String) As Long

'General constants
Public Const FDC = 0

'ItemListArray list types constants
Public Const CATEGORIES = 1
Public Const CATEGORY_MEMBERS = 2
Public Const CURRENCIES = 3
Public Const MONTHS = 5
Public Const PERIODICITIES = 6
Public Const PERIODS = 7
Public Const RATEIDS = 8
Public Const SCHEDULE_LINES = 9
Public Const SCHEDULES = 10
Public Const VERSIONS = 11
Public Const UNITS = 12
Public Const YEARS = 13
Public Const CHILDREN = 18

'ItemListArray layouts              Col1           Col2            Col3
Public Const NUM = 1               'ShortNum       None            None
Public Const DESC = 2              'Description    None            None
Public Const NUM_DESC = 3          'ShortNum       Description     None
Public Const IDDESC = 4            'LongID & Desc  None            None
Public Const NUM_IDDESC = 5        'ShortNum       LongID & Desc   None
Public Const DESC_IDDESC = 6       'Description    LongID & Desc   None
Public Const NUM_DESC_IDDESC = 7   'ShortNum       Description     LongID & Desc

'ItemListArray Schedule types
Public Const TYPE_1_ONLY = 1
Public Const TYPE_2_ONLY = 2
Public Const NO_TYPE_3 = 3
Public Const TYPE_3_ONLY = 4
Public Const NO_TYPE_2 = 5
Public Const NO_TYPE_1 = 6
Public Const ALL_TYPES = 7

'System Maximums
Public Const MAX_LINES_PER_SCHEDULE = 405
'
'Purpose:   Wrapper for CMDR.CrossCheck
'
Sub CrossCheck( _
    UnitIdOrPackage As String, _
    Version As String, _
    Period As Integer, _
    Year As Integer, _
    TransmissionFileOption As String)

    Dim UnitPackagePath As String
    
    'if UnitIdOrPackage is a package
    If Left(UnitIdOrPackage, 1) = "$" Then
    
        'if unit package does not exist warn user
        UnitPackagePath = GetCurrentDatabaseDirectory & "\" & UnitIdOrPackage & ".UNT"
        If IsFile(UnitPackagePath) = False Then
            MsgBox _
                "Unit Package $" & UnitIdOrPackage & " " & _
                "does not exist cannot run action.", _
                vbCritical + vbOKOnly, _
                BOX_TITLE
            End
        End If
        
    End If
    
    'run cross check action
    Application.Run "CMDR.CrossCheck", _
        UnitIdOrPackage, Version, Period, Year, TransmissionFileOption

End Sub
'
'Purpose:   Wrapper for CMDR.Consolidation
'
Sub Consolidate( _
    ScheduleIdOrPackage As String, _
    PeriodFrom As Integer, _
    PeriodTo As Integer, _
    Year As Integer, _
    UnitId As String, _
    Category As String, _
    Optional LevelDepth As Integer = 99)

    Dim SchedulePackagePath As String
        
    'if ScheduleIdOrPackage is package
    If Left(ScheduleIdOrPackage, 1) = "$" Then
    
        'if schedule package does not exist warn user
        SchedulePackagePath = GetCurrentDatabaseDirectory & "\$MCON.PKG"
        If IsFile(SchedulePackagePath) = False Then
            MsgBox _
                "Schedule Package $MCON " & _
                "does not exist cannot run batch.", _
                vbCritical + vbOKOnly, _
                BOX_TITLE
            End
            
        End If
    
    End If
    
    'consoldiate
    Application.Run "CMDR.Consolidation", _
        ScheduleIdOrPackage, _
        PeriodFrom, _
        PeriodTo, _
        Year, _
        UnitId, _
        Category, _
        LevelDepth

End Sub
'
'Purpose:   Wrapper for CMDR.GenerateNumbersByLevel
'
Sub GenerateNumbersByLevel( _
    UnitId As String, _
    Category As String, _
    Depth As Integer, _
    PeriodFrom As Integer, _
    PeriodTo As Integer, _
    Year As Integer, _
    ScheduleIdOrPackage, _
    Optional RUOnly As String = "Y", _
    Optional LocalBaseOpt As Integer = 1, _
    Optional DoCategories As String = "N", _
    Optional Location As String = "C")
    
    Dim SchedulePackagePath As String
        
    'if ScheduleIdOrPackage is package
    If Left(ScheduleIdOrPackage, 1) = "$" Then
    
        'schedule package path
        SchedulePackagePath = _
            GetCurrentDatabaseDirectory & "\" & _
            ScheduleIdOrPackage & ".PKG"
            
        'if schedule package does not exist warn user
        If IsFile(SchedulePackagePath) = False Then
            MsgBox _
                "Schedule Package " & ScheduleIdOrPackage & " " & _
                "does not exist cannot run action.", _
                vbCritical + vbOKOnly, _
                BOX_TITLE
            End
            
        End If
    
    End If
    MsgBox RUOnly
    'generate numbers
    Application.Run "CMDR.GenerateNumbersByLevel", UnitId, Category, Depth, _
        PeriodFrom, Year, PeriodTo, Year, ScheduleIdOrPackage, RUOnly, _
        LocalBaseOpt, DoCategories, Location
        
End Sub
'
'Purpose:   Return an array of categories
'
Function GetCategoriesArray(Optional Layout As Integer = IDDESC) As Variant

    Dim CategoriesArray As Variant
    
    'get currencies array
    CategoriesArray = Application.Run( _
        "CMDR.ItemListArray", _
        CATEGORIES, _
        Layout, _
        Workbooks(WORKBOOK_NAME).Sheets("Lists").Range("A1:C1"))
    GetCategoriesArray = CategoriesArray

End Function
'
'Purpose:   Return an array of category members
'
Function GetCategoryMembersArray( _
    Optional Layout As Integer = IDDESC, _
    Optional Category As String) As Variant

    Dim CategoryMembersArray As Variant
    
    'get currencies array
    CategoryMembersArray = Application.Run( _
        "CMDR.ItemListArray", _
        CATEGORY_MEMBERS, _
        Layout, _
        Workbooks(WORKBOOK_NAME).Sheets("Lists").Range("A1:C1"), _
        Category)
    GetCategoryMembersArray = CategoryMembersArray

End Function
'
'Purpose:   Return an array of child units
'
Function GetChildrenArray( _
    ParentShort As Integer, _
    Optional Depth As Integer = 99, _
    Optional Layout As Integer = IDDESC) As Variant
    
    Dim ChildrenArray1D As Variant
    Dim ChildrenArray2D As Variant
    Dim ChildrenCount As Integer
    Dim ChildrenIndex As Integer
    
    'get children of parent array
    ChildrenArray2D = Application.Run( _
        "CMDR.ItemListArray", _
        CHILDREN, _
        Layout, _
        Workbooks(WORKBOOK_NAME).Sheets("Lists").Range("A1:C1"), _
        ParentShort, _
        , _
        , _
        Depth)
    
    'if array has one unit no conversion needed
    ChildrenCount = UBound(ChildrenArray2D, 1)
    If ChildrenCount = 1 Then
    
        ChildrenArray1D = ChildrenArray2D
        
    'else convert 2d array to 1d array
    Else
        
        ReDim ChildrenArray1D(ChildrenCount)
        For ChildrenIndex = 1 To ChildrenCount
            ChildrenArray1D(ChildrenIndex) = ChildrenArray2D(ChildrenIndex, 1)
        Next ChildrenIndex
        
    End If
    
    'return array
    GetChildrenArray = ChildrenArray1D

End Function
'
'Purpose:   Return an array of currencies
'
Function GetCurrenciesArray(Optional Layout As Integer = IDDESC) As Variant

    Dim CurrenciesArray As Variant
    
    'get currencies array
    CurrenciesArray = Application.Run( _
        "CMDR.ItemListArray", _
        CURRENCIES, _
        Layout, _
        Workbooks(WORKBOOK_NAME).Sheets("Lists").Range("A1:C1"))
    GetCurrenciesArray = CurrenciesArray

End Function
'
'Purpose:   Return database name
'
Public Function GetDatabaseAlias() As String

    Dim Result As Integer
    Dim Product As Integer
    Dim DatabaseAlias As String * 144

    Product = FDC
    Result = FADBGetDatabaseAlias(Product, DatabaseAlias)
    GetDatabaseAlias = Trim(DatabaseAlias)

End Function
'
'Purpose:   Return database directory
'
Public Function GetCurrentDatabaseDirectory() As String

    Dim DirectoryArray As Variant
    DirectoryArray = Application.Run("GetDatabaseDirectory")
    GetCurrentDatabaseDirectory = DirectoryArray(2)
    
End Function
'
'Purpose:   Return an array of months
'
Public Function GetMonthsArray(Optional Layout As Integer = IDDESC) As Variant

    Dim MonthsArray As Variant
    
    'get months array
    MonthsArray = Application.Run( _
        "CMDR.ItemListArray", _
        MONTHS, _
        Layout, _
        Workbooks(WORKBOOK_NAME).Sheets("Lists").Range("A1:C1"))
    GetMonthsArray = MonthsArray

End Function
'
'Purpose:   Return an array of Periodicities
'
Function GetPeriodicitiesArray(Optional Layout As Integer = IDDESC) As Variant

    Dim PeriodicitiesArray As Variant
    PeriodicitiesArray = Application.Run( _
        "CMDR.ItemListArray", _
        PERIODICITIES, _
        Layout, _
        Workbooks(WORKBOOK_NAME).Sheets("Lists").Range("A1:C1"))
    GetPeriodicitiesArray = PeriodicitiesArray

End Function
'
'Purpose:   Return an array of Periods
'
Function GetPeriodsArray( _
    Periodicity As String, _
    Optional Layout As Integer = IDDESC) As Variant

    Dim PeriodsArray As Variant
    PeriodsArray = Application.Run( _
        "CMDR.ItemListArray", _
        PERIODS, _
        4, _
        Workbooks(WORKBOOK_NAME).Sheets("Lists").Range("A1:C1"), _
        Periodicity)
    GetPeriodsArray = PeriodsArray

End Function
'
'Purpose:   Return an array of rate ids
'
Function GetRateIdsArray(Optional Layout As Integer = IDDESC) As Variant

    Dim RateIdsArray As Variant
    RateIdsArray = Application.Run( _
        "CMDR.ItemListArray", _
        RATEIDS, _
        Layout, _
        Workbooks(WORKBOOK_NAME).Sheets("Lists").Range("A1:C1"))
    GetRateIdsArray = RateIdsArray

End Function
'
'Purpose:   Return an array of schedules
'
Function GetSchedulesArray( _
    Optional Layout As Integer = IDDESC, _
    Optional ScheduleType As Integer = ALL_TYPES)
    
    Dim SchedulesArray As Variant
    SchedulesArray = Application.Run( _
        "CMDR.ItemListArray", _
        SCHEDULES, _
        Layout, _
        Workbooks(WORKBOOK_NAME).Sheets("Lists").Range("A1:C1"), _
        ScheduleType)
    GetSchedulesArray = SchedulesArray

End Function
'
'Purpose:   Return an array of schedule lines
'
Function GetScheduleLinesArray( _
    Schedule As String, _
    Optional Layout As Integer = IDDESC) As Variant
    
    Dim ScheduleLinesArray As Variant
    ScheduleLinesArray = Application.Run( _
        "CMDR.ItemListArray", _
        SCHEDULE_LINES, _
        Layout, _
        Workbooks(WORKBOOK_NAME).Sheets("Lists").Range("A1:C1"))
    GetScheduleLinesArray = ScheduleLinesArray

End Function
'
'Purpose:   Return an array of schedule versions
'Notes:     The CMDR.ItemListArray function only returns descriptions for
'           layout 4 so default is layout 1.
'
Function GetVersionsArray(Optional Layout As Integer = NUM) As Variant
    
    Dim VersionsArray As Variant
    VersionsArray = Application.Run( _
        "CMDR.ItemListArray", _
        VERSIONS, _
        Layout, _
        Workbooks(WORKBOOK_NAME).Sheets("Lists").Range("A1:C1"))
    GetVersionsArray = VersionsArray

End Function
'
'Purpose:   Return short unit id for long unit id
'
Function GetUnitNo(UnitId As String) As Integer

    GetUnitNo = _
        Application.Run("CMDR.ShortUnitId", UnitId)

End Function
'
'Purpose:   Return an array of units
'Notes:     Not sure if Exclude option works
'
Function GetUnitsArray( _
    Optional Layout As Integer = IDDESC, _
    Optional UnitTypes As String = "CER", _
    Optional Exclude As String, _
    Optional Order As Boolean = True) As Variant
    
    Dim UnitsArray As Variant
    UnitsArray = Application.Run( _
        "CMDR.ItemListArray", _
        UNITS, _
        Layout, _
        Workbooks(WORKBOOK_NAME).Sheets("Lists").Range("A1:C1"), _
        UnitTypes, _
        Exclude, _
        Order)
    GetUnitsArray = UnitsArray

End Function
'
'Purpose:   Get array of Years
'
Function GetYearsArray(Optional Layout As Integer = IDDESC) As Variant

    Dim YearsArray As Variant
    YearsArray = Application.Run( _
        "CMDR.ItemListArray", _
        YEARS, _
        4, _
        Workbooks(WORKBOOK_NAME).Sheets("Lists").Range("A1:C1"))
    GetYearsArray = YearsArray

End Function
'
'Purpose:
'
Function IsCatMember( _
    CategoryTable As Variant, _
    CategoryMember As Variant) As Boolean
    
On Error GoTo HandleErrors

    Dim vReturn As Variant
    vReturn = Application.Run("ValidCatMember", vCategoryTable, vCategoryMember)
    If vReturn <> False Then
        fIsCatMember = True
    Else
        fIsCatMember = False
    End If

ExitProcedure:
    Exit Function
    
HandleErrors:
    fIsCatMember = False
    Resume ExitProcedure
    
End Function
'
'Purpose:   Return True if FDC Addins have been loaded.
'
Function IsLoggedIn() As Boolean
On Error GoTo HandleErrors
    Dim v As Variant
    v = Application.Run("UserIsLoggedIn")
    IsLoggedIn = True
    
ExitProcedure:
    Exit Function
    
HandleErrors:
    IsLoggedIn = False
    Resume ExitProcedure
    
End Function
'
'Purpose:   Returns true if package name is valid
'Arguments: <PackageName> Package name e.g. $ASPL.PKG
'Notes:     This package is private because it should only be called by
'           IsSchedulePackageNameValid and IsUnitPackageNameValid
'
Private Function IsPackageNameValid( _
    PackageName As String, _
    Optional DisplayErrorMessages As Boolean = False) As Boolean

    'if package name does not start with $ warn user
    If Left(PackageName, 1) <> "$" Then
        If DisplayErrorMessages = True Then
            MsgBox _
                "Package names must start with a $.", _
                vbInformation + vbOKOnly, _
                BOX_TITLE
        End If
        IsPackageNameValid = False
        Exit Function
    End If
    
    'if main part of package name is longer than five characters warn user
    If Len(GetFileNameMain(PackageName)) > 5 Then
        If DisplayErrorMessages = True Then
            MsgBox _
                "Main part of package names must be five characters or less.", _
                vbInformation + vbOKOnly, _
                BOX_TITLE
        End If
        IsPackageNameValid = False
        Exit Function
    End If
    
    'if package name contains illegal characters then warn user
    If IsFileNameValid(PackageName) = False Then
        If DisplayErrorMessages = True Then
            MsgBox _
                "Package names contains invalid characters", _
                vbInformation + vbOKOnly, _
                BOX_TITLE
        End If
        IsPackageNameValid = False
        Exit Function
    End If
    
    IsPackageNameValid = True

End Function
'
'Purpose:   Returns true if schedule exists
'
Function IsSchedule(vSchedule As Variant) As Boolean

    Dim vReturn As Variant
    
    vReturn = Application.Run("ValidSched", vSchedule)
    If VarType(vReturn) > 8192 Then
        IsSchedule = True
    Else
        IsSchedule = False
    End If
    
End Function
'
'Purpose:   Returns true if schedule package does not exist or contains
'           invalid schedules
'Arguments: <PackageName> Schedule package name without extension e.g. $USA
'Example:   IsSchedulePackageValid("$USA")
'
Function IsSchedulePackageValid(PackageName As String) As Boolean

On Error GoTo HandleError
    
    Dim FileNumber As Integer
    Dim PackagePathAndName As String
    Dim Schedule As String
    
    'combine path, package name and extension
    PackagePathAndName = _
        GetCurrentDatabaseDirectory() & "\" & PackageName & ".pkg"
    
    'if package does not exist return false
    If IsFile(PackagePathAndName) = False Then
        IsSchedulePackageValid = False
        Exit Function
    End If
    
    'open file for package
    FileNumber = FreeFile()
    Open PackagePathAndName For Input As FileNumber
        
    'for each row of package
    Do While Not EOF(FileNumber)
    
        'if schedule does not exist return false
        Line Input #FileNumber, Schedule
        If IsSchedule(Schedule) = False Then
            IsSchedulePackageValid = False
            Exit Function
        End If
        
    Loop
    
    Close FileNumber
     
    IsSchedulePackageValid = True

ExitProcedure:

    Exit Function

HandleError:
    
    Call MsgFileError("IsSchedulePackageValid", PackagePathAndName, Err)
    IsSchedulePackageValid = False
    Resume ExitProcedure

End Function
'
'Purpose:   Returns true if package name is valid
'Arguments: <PackageName> Package name e.g. $ASPL.PKG
'           [DisplayErrorMessages] Display descriptions of errors
'
Function IsSchedulePackageNameValid( _
    PackageName As String, _
    Optional DisplayErrorMessages As Boolean = False) As Boolean

    'if package name is not valid
    If IsPackageNameValid(PackageName, DisplayErrorMessages) = False Then
        IsSchedulePackageNameValid = False
        Exit Function
    End If
    
    'if extension is not pkg warn user
    If UCase(GetExtension(PackageName)) <> "PKG" Then
        If DisplayErrorMessages = True Then
            MsgBox _
                "Schedule packages must have an extension of .pkg.", _
                vbInformation + vbOKOnly, _
                BOX_TITLE
        End If
        IsSchedulePackageNameValid = False
        Exit Function
    End If
    
    IsSchedulePackageNameValid = True

End Function
'
'Purpose:   Returns true if unit exists.
'Examples:  IsUnit("BCI0")
'           IsUnitId(999)
'
Function IsUnit(ShortOrLongUnitId As Variant) As Boolean

    Dim ValidUnitReturn As Variant
    
    ValidUnitReturn = Application.Run("ValidUnit", ShortOrLongUnitId)
   
    If VarType(ValidUnitReturn) > 8192 Then
        IsUnit = True
    Else
        IsUnit = False
    End If
    
End Function
'
'Purpose:   Returns true if long unit id exists.
'Examples:  IsReportingUnit("BCI0")
'
Function IsReportingUnit(UnitId As Variant) As Boolean
On Error GoTo HandleError

    Dim UnitNoCheck As Integer
    Dim UnitNoArray As Variant
    Static ReportingUnitsArray As Variant
   
    'if reporting units array is uninitialized get array
    If VarType(ReportingUnitsArray) = vbEmpty Then
        ReportingUnitsArray = GetUnitsArray(NUM, "R")
    End If
    
    UnitNoCheck = GetUnitNo(CStr(UnitId))
    For Each UnitNoArray In ReportingUnitsArray
    
        'if unit exist return true and exit
        If UnitNoCheck = UnitNoArray Then
            IsReportingUnit = True
            Exit Function
        End If
        
    Next
    
ExitProcedure:
    
    IsReportingUnit = False
    Exit Function
    
HandleError:

    Resume ExitProcedure
    
End Function
'
'Purpose:   Returns true if unit package does not exist or contains invalid
'           units.
'Arguments: <PackageName> unit package name without extension e.g. $AALL
'Example:   IsUnitPackageValid("$USA")
'
Function IsUnitPackageValid(PackageName As String) As Boolean

On Error GoTo HandleError
    
    Dim FileNumber As Integer
    Dim PackagePathAndName As String
    Dim UnitShortId As String
    
    'combine path, package name and extension
    PackagePathAndName = _
        GetCurrentDatabaseDirectory() & "\" & PackageName & ".unt"
    
    'if package does not exist return false
    If IsFile(PackagePathAndName) = False Then
        IsUnitPackageValid = False
        Exit Function
    End If
    
    'open package
    FileNumber = FreeFile()
    Open PackagePathAndName For Input As FileNumber
        
    'for each row of package
    Do While Not EOF(FileNumber)
    
        'if UnitShortId does not exist return false
        Line Input #FileNumber, UnitShortId
        If IsUnit(CInt(UnitShortId)) = False Then
            IsUnitPackageValid = False
            Exit Function
        End If
        
    Loop
    
    Close FileNumber
     
    IsUnitPackageValid = True

ExitProcedure:

    Exit Function

HandleError:
    
    Call MsgFileError("IsUnitPackageValid", PackagePathAndName, Err)
    IsUnitPackageValid = False
    Resume ExitProcedure

End Function
'
'Purpose:   Returns true if package name is valid
'Arguments: <PackageName> Package name e.g. $ASPL.PKG
'
Function IsUnitPackageNameValid( _
    PackageName As String, _
    Optional DisplayErrorMessages As Boolean = False) As Boolean

    'if package name is not valid
    If IsPackageNameValid(PackageName, DisplayErrorMessages) = False Then
        IsUnitPackageNameValid = False
        Exit Function
    End If
    
    'if extension is not UNT warn user
    If UCase(GetExtension(PackageName)) <> "UNT" Then
        If DisplayErrorMessages = True Then
            MsgBox _
                "Unit packages must have an extension of .unt.", _
                vbInformation + vbOKOnly, _
                BOX_TITLE
        End If
        IsUnitPackageNameValid = False
        Exit Function
    End If
    
    IsUnitPackageNameValid = True

End Function
'
'Purpose:
'
Sub GroupID(strUnit As Variant)

    Dim v As Variant
    v = Application.Run("[CMDRGEN1.XLA]CMDRGEN1!ValidUnit", 459)
    MsgBox VarType(v)
    
End Sub
'
'Purpose:   Test if Excel is attach to Comshare FDC database.
'
Function IsAttachedToDB() As Boolean
On Error GoTo HandleErrors

    Dim Prompt As String
    Dim ReturnValue As Variant
    
    'display message on status bar
    Application.StatusBar = "Attaching to Comshare FDC Database"
    
    'attach to Comshare FDC database
    IsAttachedToDB = Application.Run("AttachToDB")
       
ExitProcedure:
    Application.StatusBar = False
    Exit Function

HandleErrors:
    IsAttachedToDB = False
    Resume ExitProcedure
    
End Function
'
'Purpose:   Import data into FDC using MCDESave
'Arguments: <FirstCell> Cell containing first cell of schedule e.g. C5
'           <Schedule> Schedule code e.g. "A1199"
'           <Unit> Long unit ID e.g. "1000"
'           <Category> Category e.g. "0000"
'           <Period> Period number e.g. 9
'           <Year> Year number e.g. 99
'           [Message] Message displayed on status line
'
Function SaveData( _
    FirstCellRange As Range, _
    Schedule As String, _
    UnitId As String, _
    Category As String, _
    Period As Integer, _
    Year As Integer, _
    Optional Message As String = "Importing: ") As Boolean
    
On Error GoTo HandleErrors

    Dim SchedulesArray(1 To 1) As String
    Dim ShortUnitIdsArray(1 To 1) As Integer
    Dim CategoryMembersArray(1 To 1) As String
    Dim PeriodsArray(1 To 1) As Integer
    Dim YearsArray(1 To 1) As Integer
    Dim ProtectedArray(1 To 1) As Boolean
    Dim PeriodicArray(1 To 1) As Boolean
    Dim ChangedArray(1 To 1) As Boolean
    Dim ReturnValue As Variant
    Dim StatusBarPreference As Boolean
    
    'save status bar preference
    StatusBarPreference = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    
    'tell user what is happening
    Application.StatusBar = _
        "Importing: " & UnitId & "-" & Schedule & "-" & Period & "-" & Year
    
    'set arguments for MCDESave
    SchedulesArray(1) = Schedule
    ShortUnitIdsArray(1) = Application.Run("CMDR.ShortUnitId", UnitId)
    CategoryMembersArray(1) = Category
    PeriodsArray(1) = Period
    YearsArray(1) = GetYearYY(Year)
    ProtectedArray(1) = False
    PeriodicArray(1) = False
    ChangedArray(1) = True
    
    'import data using MCDESave
    ReturnValue = Application.Run( _
        "MCDESave", _
        FirstCellRange, _
        SchedulesArray, _
        ShortUnitIdsArray, _
        CategoryMembersArray, _
        PeriodsArray, _
        YearsArray, _
        ProtectedArray, _
        PeriodicArray, _
        ChangedArray)
        
    If ReturnValue(1) = False Then
        SaveData = False
        SaveDataErrorMessage FirstCellRange, Schedule, ReturnValue
        GoTo ExitProcedure
    End If
    
    'Got this far schedule data must have been saved
    SaveData = True

ExitProcedure:

    'reset status bar
    Application.StatusBar = False
    Application.DisplayStatusBar = StatusBarPreference
    
    Exit Function
    
HandleErrors:

    'warn user, return false and exit procedure
    MsgBox _
        "Cannot import data to schedule " & Schedule & ". " & _
        "A unidentified error occurred.", _
        vbInformation + vbOKOnly, _
        BOX_TITLE
    SaveData = False
    Resume ExitProcedure

End Function

'
'Purpose:   Displays a message box explaining the error returned by MCDEData
'
Sub SaveDataErrorMessage( _
    FirstCellRange As Range, _
    Schedule As String, _
    Error As Variant)
    
On Error GoTo HandleErrors

    Dim Prompt As String
    
    'Set the first sentence of the message
    Prompt = "Cannot import data to schedule " & Schedule & ". "
    
    'If error with arguments
    If IsError(Error(1)) Then
        Prompt = Prompt & _
            "There was an error with the arguments passed to MCDESave " & _
            "for this schedule."
        
        'Select schedule with error
        FirstCellRange.Activate
                    
    'If no columns to import
    ElseIf Error(2) = 1 Then
        Prompt = Prompt & _
            "There are no columns to Import. None have been edited " & _
            "or all are protected."
    
    'Select schedule with error
    FirstCellRange.Activate
                   
    'If downfoot error
    ElseIf Error(2) = 2 Then
        Prompt = Prompt & _
            "The total in the current cell is not correct. Check " & _
            "the data adds up and that there are no rounding errors."
           
        'Select cell with error
        Cells(Error(3), Error(4)).Activate
        
    'If line does not have a value
    ElseIf Error(2) = 3 Then
        Prompt = Prompt & _
            "The current cell is not a header line and must contain " & _
            "a numeric value. Check the schedule layout and the " & _
            "address of the first cell on the ImportRanges sheet."
            
        'Select cell with error
        Cells(Error(3), Error(4)).Activate
            
    'if error occurred reading a cell value
    ElseIf Error(2) = 4 Then
        Prompt = Prompt & _
            "A error occurred reading the value in the current cell."
        
        'Select cell with error
        Cells(Error(3), Error(4)).Activate
            
    'If an error occurred saving data
    ElseIf Error(2) = 5 Then
        Prompt = Prompt & "A error occurred while saving the data."
        
    'Select schedule with error
    FirstCellRange.Activate
        
    'Else another error occurred
    Else
        Prompt = Prompt & _
            "A unidentified error occurred." & CRLF() & _
            "Error VarType = " & VarType(Error)
    
    'Select schedule with error
    FirstCellRange.Activate
       
    End If
    
    MsgBox Prompt, vbInformation + vbOKOnly, BOX_TITLE

ExitProcedure:

    Exit Sub

HandleErrors:

    MsgBox _
        "Cannot save data to schedule " & Schedule & ". " & _
        "A unidentifiederror occurred.", _
        vbInformation + vbOKOnly, _
        BOX_TITLE
        
    Resume ExitProcedure
    
End Sub