Malicious Office (OLE) / .XLA — malware analysis report

Attribute VB_Name = "Navigate"

Option Base 1
Dim OnSheetName As String
Public TableName As String
Public GoToDialogTable As Boolean
Public LocationInfo As Object
Dim ReturningToLastTable As Boolean
Dim SelectedRefresh As Boolean
'
Sub Go_To_Outline()
    Application.EnableCancelKey = xlDisabled
    On Error GoTo GoToOutlineError
    Sheets("Table Outline").Select
    Range("A1").Select
    Exit Sub
GoToOutlineError:
    MsgBox "Can't go to outline!"
End Sub
'
Sub Go_To_Selected_Table()
    Application.EnableCancelKey = xlDisabled
    On Error GoTo GoToSelectedTableError
    Set LocationInfo = Application.Workbooks("SDI Industry Data Interface.xla").Sheets("LocationInfo")
    Transfer_Table_Name_Lists
    ReturningToLastTable = False
    Set_Save_Table_Parameters
    FindingRemoteTable = False
    GoToDialogTable = False
    Find_The_Table
    Set_Return_Screen_And_Table_Parameters
    Exit Sub
GoToSelectedTableError:
    MsgBox "Can't go to selected table!"
End Sub
'
Sub Go_To_Parent_Table_Field()
    Application.EnableCancelKey = xlDisabled
    On Error GoTo GoToParentFieldError
    Set LocationInfo = Application.Workbooks("SDI Industry Data Interface.xla").Sheets("LocationInfo")
    Transfer_Table_Name_Lists
    'Go to the parent table.
    ReturningToLastTable = False
    Set_Save_Table_Parameters
    FindingRemoteTable = False
    GoToDialogTable = True
    Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("GOTODialog").EditBoxes(1).Text = _
     IndexedFieldDialog.EditBoxes("Table Edit Box").Text
    Find_The_Table
    'Go to the parent field.
    If IndexedFieldDialog.EditBoxes("Field Edit Box").Text = "" Then
        'No where to go, field name is empty.
    Else
        Application.DisplayAlerts = False
        Cells.Find(what:=IndexedFieldDialog.EditBoxes("Field Edit Box").Text, _
         after:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
         SearchDirection:=xlNext, MatchCase:=False).Activate
        Application.DisplayAlerts = True
    End If
    Set_Return_Screen_And_Table_Parameters
    Exit Sub
GoToParentFieldError:
    MsgBox "Can't go to parent table/field!"
    Application.DisplayAlerts = True
    Exit Sub
End Sub
'
Sub Go_To_Table()
    Dim StartSheetName As String
    Application.EnableCancelKey = xlDisabled
    Application.ScreenUpdating = False
    On Error GoTo Go_To_Table_Definition_Error
    Set LocationInfo = Application.Workbooks("SDI Industry Data Interface.xla").Sheets("LocationInfo")
PickTable:
    Transfer_Table_Name_Lists
    'Reset dialog.
    Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("GOTODialog").ListBoxes(1).ListFillRange = "GOTO_Alpha"
    Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("GOTODialog").EditBoxes(1).Text = ""
    Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("GOTODialog").ListBoxes(1).Value = 0
    '1/15/00 RES Set return to table button properties.
    If LocationInfo.Range("Can_Return_To_Table") = True Then
        Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("GOTODialog").Buttons("Return Button").Enabled = True
        Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("GOTODialog").Buttons("Return Button").Text = _
         "Return to '" & LocationInfo.Range("Return_Table_Name").Value & "'..."
    Else
        Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("GOTODialog").Buttons("Return Button").Enabled = False
        Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("GOTODialog").Buttons("Return Button").Text = _
         "Return to..."
    End If
    ReturningToLastTable = False
    Set_Save_Table_Parameters
    SelectedRefresh = False
    If Not Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("GOTODialog").Show Then
        '12/28/99 RES Commented verification dialog out.
        'MsgBox "You chose to 'Cancel' the GO TO function."
        Exit Sub
    End If
    'Check if user selected refresh list.
    If SelectedRefresh Then
        StartSheetName = ActiveSheet.Name
        MakeUpdatingFile = True
        Update_Excel_Tabs_Table
        Sheets(StartSheetName).Activate
        MakeUpdatingFile = False
        GoTo PickTable
        Exit Sub
    End If
    'Check if user picked a blank.
    If Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("GOTODialog").EditBoxes(1).Text = "" And Not ReturningToLastTable Then
        MsgBox "Pick a table name to GO TO."
        GoTo PickTable
        Exit Sub
    End If
    FindingRemoteTable = False
    GoToDialogTable = True
    If ReturningToLastTable Then
        Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("GOTODialog").EditBoxes(1).Text = _
         LocationInfo.Range("Return_Table_Name").Value
    End If
    Find_The_Table
    Set_Return_Screen_And_Table_Parameters
    Exit Sub
Go_To_Table_Definition_Error:
    MsgBox "'Go To Table...' parameters could not be defined!"
End Sub
'
Sub Clicked_Refresh_List()
    SelectedRefresh = True
End Sub
'
Sub Clicked_Return_To_Last_Table()
    ReturningToLastTable = True
End Sub
'
Sub Return_To_Table()
    Application.EnableCancelKey = xlDisabled
    Application.ScreenUpdating = False
    On Error GoTo Return_To_Table_Definition_Error
    Set LocationInfo = Application.Workbooks("SDI Industry Data Interface.xla").Sheets("LocationInfo")
    Transfer_Table_Name_Lists
    '1/15/00 RES Set return to table button properties.
    If LocationInfo.Range("Can_Return_To_Table") = True Then
        Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("GOTODialog").Buttons("Return Button").Enabled = True
        Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("GOTODialog").Buttons("Return Button").Text = _
         "Return to '" & LocationInfo.Range("Return_Table_Name").Value & "'..."
    Else
        Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("GOTODialog").Buttons("Return Button").Enabled = False
        Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("GOTODialog").Buttons("Return Button").Text = _
         "Return to..."
    End If
    ReturningToLastTable = True
    Set_Save_Table_Parameters
    FindingRemoteTable = False
    GoToDialogTable = True
    Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("GOTODialog").EditBoxes(1).Text = _
     LocationInfo.Range("Return_Table_Name").Value
    Find_The_Table
    Set_Return_Screen_And_Table_Parameters
    Exit Sub
Return_To_Table_Definition_Error:
    MsgBox "'Return to...' parameters could not be defined!"
End Sub
'
Sub Transfer_Table_Name_Lists()
    Dim ListBottom As Object
    Application.EnableCancelKey = xlDisabled
    Application.ScreenUpdating = False
    On Error GoTo Transfer_Lists_Error
    Define_Excel_Tabs_Table
    'Bring in table names from active DB file.
    'Alphabetic table names.
    Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("GOTO_Alpha").ClearContents
    ExcelTabsTables.Copy
    Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("GOTO_Alpha_Top").Offset(1, 0).PasteSpecial Paste:=xlValues
    If Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("GOTO_Alpha_Top").Offset(2, 0).Value = "" Then
        'Only one table.
        Set ListBottom = Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("GOTO_Alpha_Top").Offset(1, 0)
    Else
        Set ListBottom = Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("GOTO_Alpha_Top").End(xlDown)
    End If
    Application.DisplayAlerts = False 'Do want Excel to replace the defined name.
    Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("GOTO_Alpha_Top", ListBottom).CreateNames Top:=True
    'Alphabetize the list.
    Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("GOTO_Alpha").Sort _
     Key1:=Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("GOTO_Alpha_Top"), header:=xlNo
    'Table names.
    Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("GOTO_Table").ClearContents
    ExcelTabsTables.Copy
    Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("GOTO_Table_Top").Offset(1, 0).PasteSpecial Paste:=xlValues
    If Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("GOTO_Alpha_Top").Offset(2, 0).Value = "" Then
        'Only one table.
        Set ListBottom = Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("GOTO_Table_Top").Offset(1, 0)
    Else
        Set ListBottom = Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("GOTO_Table_Top").End(xlDown)
    End If
    Application.DisplayAlerts = False 'Do want Excel to replace the defined name.
    Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("GOTO_Table_Top", ListBottom).CreateNames Top:=True
    'Sheet names.
    Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("GOTO_Sheet").ClearContents
    ExcelTabsTabs.Copy
    Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("GOTO_Sheet_Top").Offset(1, 0).PasteSpecial Paste:=xlValues
    If Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("GOTO_Alpha_Top").Offset(2, 0).Value = "" Then
        'Only one table.
        Set ListBottom = Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("GOTO_Sheet_Top").Offset(1, 0)
    Else
        Set ListBottom = Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("GOTO_Sheet_Top").End(xlDown)
    End If
    Application.DisplayAlerts = False 'Do want Excel to replace the defined name.
    Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("GOTO_Sheet_Top", ListBottom).CreateNames Top:=True
    Application.DisplayAlerts = True
    Exit Sub
Transfer_Lists_Error:
    MsgBox "Dialog selection lists could not be defined!"
    Application.DisplayAlerts = True
End Sub
'
'1/15/00 RES Add procedure for returing to last table.
Sub Set_Save_Table_Parameters()
    Dim CheckCell As Object
    Dim TopRow As Single
    Application.EnableCancelKey = xlDisabled
    On Error GoTo CantSetSaveParams
    Set CheckCell = Cells(ActiveCell.Row, 1).CurrentRegion.Range("A1") 'The upper left hand corner of the first column of active cell row current region.
    TopRow = ActiveWindow.ScrollRow 'Excel otherwise wants to scroll the screen.
    LocationInfo.Range("Save_Active_Row").Value = ActiveCell.Row
    LocationInfo.Range("Save_Active_Column").Value = ActiveCell.Column
    LocationInfo.Range("Save_Scroll_Row").Value = ActiveWindow.ScrollRow
    LocationInfo.Range("Save_Scroll_Column").Value = ActiveWindow.ScrollColumn
    'Check if in a table header.
    If CheckCell.Value = "Table" Then
        LocationInfo.Range("Save_Table_Name").Value = CheckCell.Offset(0, 2)
        ActiveWindow.ScrollRow = TopRow
        LocationInfo.Range("Can_Return_To_Table") = "TRUE"
        Exit Sub
    End If
    'Check if in a table.
    If CheckCell.End(xlUp).Value = "Table" Then 'With no notes.
        LocationInfo.Range("Save_Table_Name").Value = CheckCell.End(xlUp).Offset(0, 2).Value
        ActiveWindow.ScrollRow = TopRow
        LocationInfo.Range("Can_Return_To_Table") = "TRUE"
        Exit Sub
    ElseIf CheckCell.End(xlUp).Value = "Notes" Then  'With notes.
        LocationInfo.Range("Save_Table_Name").Value = CheckCell.End(xlUp).End(xlUp).Offset(0, 2).Value
        ActiveWindow.ScrollRow = TopRow
        LocationInfo.Range("Can_Return_To_Table") = "TRUE"
        Exit Sub
    End If
    'Not in a table.
    ActiveWindow.ScrollRow = TopRow
    LocationInfo.Range("Can_Return_To_Table") = "FALSE"
    Exit Sub
CantSetSaveParams:
    On Error Resume Next
    LocationInfo.Range("Can_Return_To_Table") = "FALSE"
End Sub
'
'1/15/00 RES Add procedure for returing to last table.
Sub Set_Return_Screen_And_Table_Parameters()
    Dim MItem As Object
    Application.EnableCancelKey = xlDisabled
    On Error GoTo CantSetReturnParams
    If ReturningToLastTable Then
        ActiveWindow.ScrollRow = LocationInfo.Range("Return_Scroll_Row")
        ActiveWindow.ScrollColumn = LocationInfo.Range("Return_Scroll_Column")
        ActiveSheet.Cells(LocationInfo.Range("Return_Active_Row").Value, LocationInfo.Range("Return_Active_Column").Value).Select
        'Make sure the active cell is visible.
        If ActiveCell.Column <= 255 Then
            ActiveCell.Offset(0, 1).Select
            ActiveCell.Offset(0, -1).Select
            ActiveWindow.ScrollColumn = LocationInfo.Range("Return_Scroll_Column")
        End If
    End If
    LocationInfo.Range("Return_Table_Name") = LocationInfo.Range("Save_Table_Name")
    LocationInfo.Range("Return_Active_Row") = LocationInfo.Range("Save_Active_Row")
    LocationInfo.Range("Return_Active_Column") = LocationInfo.Range("Save_Active_Column")
    LocationInfo.Range("Return_Scroll_Row") = LocationInfo.Range("Save_Scroll_Row")
    LocationInfo.Range("Return_Scroll_Column") = LocationInfo.Range("Save_Scroll_Column")
    'Set return to table menu properties.
    'Make sure the "Return to" menu item has the default name.
    For Each MItem In MenuBars(xlWorksheet).Menus("DB").MenuItems
        If Left(MItem.Caption, 10) = "Re&turn to" Then
            MenuBars(xlWorksheet).Menus("DB").MenuItems(MItem.Caption).Caption = "Re&turn to..."
            Exit For
        End If
    Next
    If LocationInfo.Range("Can_Return_To_Table") = True Then
        MenuBars(xlWorksheet).Menus("DB").MenuItems("Re&turn to...").Enabled = True
        MenuBars(xlWorksheet).Menus("DB").MenuItems("Re&turn to...").Caption = _
         "Re&turn to '" & LocationInfo.Range("Return_Table_Name").Value & "'..."
    Else
        MenuBars(xlWorksheet).Menus("DB").MenuItems("Re&turn to...").Enabled = False
    End If
    Exit Sub
CantSetReturnParams:
    On Error Resume Next
    LocationInfo.Range("Can_Return_To_Table") = "FALSE"
End Sub
'
Sub Find_The_Table()
    Dim FirstFindCell As Object
    Dim CurrentFindCell As Object
    Application.EnableCancelKey = xlDisabled
    Application.ScreenUpdating = False
    On Error GoTo NameNotFound 'In case of mismatch between outline and actual names.
    If FindingRemoteTable Then 'For importing text.
        TableName = ImportTableNameCell.Value
    Else
        If GoToDialogTable Then
            TableName = Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("GOTODialog").EditBoxes(1).Text
        Else
            TableName = ActiveCell.Value
        End If
    End If
    'Select the sheet with the table on it.
    If Not FindingRemoteTable Then
        Define_Excel_Tabs_Table
    End If
    OnSheetName = ExcelTabsTables.Find(what:=TableName, _
     after:=ExcelTabsTables.Range("A1"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
     SearchDirection:=xlNext, MatchCase:=False).Offset(0, -1)
    Sheets(OnSheetName).Select
    'Select the table.
    'AJS 2/17/98 While Loop added below to only find tables with "Table" next to it.
    Application.DisplayAlerts = False
    Cells.Find(what:=TableName, after:=Range("A1"), LookIn _
     :=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
     SearchDirection:=xlNext, MatchCase:=False).Activate
    Set FirstFindCell = ActiveCell
    Do While Not ActiveCell.Offset(0, -2).Text = "Table"
        Set CurrentFindCell = ActiveCell
        'Look for more tables.
        Cells.Find(what:=TableName, after:=CurrentFindCell, LookIn _
         :=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
         SearchDirection:=xlNext, MatchCase:=False).Activate
        If FirstFindCell.Address = ActiveCell.Address Then
            GoTo NameNotFound
        End If
    Loop
    Application.DisplayAlerts = True
    ActiveWindow.ScrollRow = ActiveCell.Row
    Exit Sub
NameNotFound:
    Application.DisplayAlerts = True
    If FindingRemoteTable Then
        FindingRemoteTable = False
    Else
        If GoToDialogTable Then
            MsgBox "Table '" & TableName & "' on sheet '" & OnSheetName & _
             "' could not be found. Check Table Outline for proper sheet / table names."
        Else
            MsgBox "Table '" & TableName & "' on sheet '" & OnSheetName & _
             "' could not be found. Make sure the cell you selected is a valid table name and that the table name is in the Table Outline."
        End If
    End If
End Sub



Attribute VB_Name = "TextOutput"

Option Base 1
Dim ReportTextOutputMessages As Boolean
'
Sub Export_DB_Text_File()
    Application.EnableCancelKey = xlDisabled
    ReportTextOutputMessages = False
    Text_Output
End Sub
'
Sub Menu_Text_Output()
    Application.EnableCancelKey = xlDisabled
    ReportTextOutputMessages = True
    Text_Output
End Sub
'
Sub Text_Output()
Attribute Text_Output.VB_ProcData.VB_Invoke_Func = " \n14"
    Dim TextOutStartSheet As String
    Dim TextSheetOutName As String
    Dim TextSaveName As String
    Application.EnableCancelKey = xlDisabled
    Application.ScreenUpdating = False
    TextOutStartSheet = ActiveSheet.Name 'To end up where started.
    List_Text_Sheets
    On Error GoTo OtherTextOutError 'For selection or memory allocation error (Mac).
    'Set dialog caption and checkbox.
    Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("PickTextSheet").DialogFrame.Caption = "Pick Text Sheet to Output..."
    Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("PickTextSheet").CheckBoxes("Check Fields Check Box").Visible = True
    Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("PickTextSheet").CheckBoxes("Check Fields Check Box").Value = xlOff
    Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("PickTextSheet").CheckBoxes("Rebuild Tabs Check Box").Visible = True
    Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("PickTextSheet").CheckBoxes("Rebuild Tabs Check Box").Value = xlOff
    If ReportTextOutputMessages Then
        If Not Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("PickTextSheet").Show Then
            Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("PickTextSheet").CheckBoxes("Check Fields Check Box").Visible = False
            Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("PickTextSheet").CheckBoxes("Rebuild Tabs Check Box").Visible = False
            MsgBox "You chose to 'Cancel' the Text Output function."
            Exit Sub
        End If
    End If
    Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("PickTextSheet").CheckBoxes("Check Fields Check Box").Visible = False
    Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("PickTextSheet").CheckBoxes("Rebuild Tabs Check Box").Visible = False
    If ReportTextOutputMessages Then
        'Check child field entries or update Excel Tabs table, if selected.
        If Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("PickTextSheet").CheckBoxes("Check Fields Check Box").Value = xlOn Then
            SetFontsOnly = False
            Check_Entries_For_All_Child_Fields
            If Stop_Due_To_Invalid_Entry Then
                Exit Sub
            End If
        ElseIf Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("PickTextSheet").CheckBoxes("Rebuild Tabs Check Box").Value = xlOn Then
            Update_Excel_Tabs_Table
        End If
    End If
    'Export the file.
    Application.StatusBar = "Preparing text file for output..."
    TextSheetOutName = Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("PickTextSheet").EditBoxes(1).Text
    '10/12/98 AJS Specific Recalc.
    If Application.Calculation = xlManual Then
        Sheets(TextSheetOutName).UsedRange.Calculate
        Sheets(TextSheetOutName).UsedRange.Calculate 'Executed twice for dependent cells on the same sheet.
    End If
    TextSheetName = TextSheetOutName 'So text sheet can be checked for errors.
    If ReportTextOutputMessages Then
        Check_Text_Sheet_For_Errors
    End If
    Sheets(TextOutStartSheet).Activate
    Sheets(TextSheetOutName).Visible = True
    'Record the DB file name in the text sheet, if there is a place for it.
    If Sheets(TextSheetOutName).Range("A1").Value = "File_Name:" Then
        Sheets(TextSheetOutName).Range("B1").Value = ActiveWorkbook.Name
    End If
    '10/12/98 AJS Recoding of output methods.
    Sheets(TextSheetOutName).UsedRange.Copy
    Set NewBook = Workbooks.Add
    NewBook.Worksheets(1).Range("A1").PasteSpecial Paste:=xlValues
    On Error GoTo 0 'Turn off error handling.
    '10/12/98 AJS Allow longer file name
    TextSaveName = TextSheetOutName
    Application.StatusBar = False
    '10/12/98 AJS No longer using Copy to new workbook
    On Error GoTo InvalidSave
    If ReportTextOutputMessages Then
        Application.Dialogs(xlDialogSaveAs).Show arg1:=TextSaveName, arg2:=3
    Else
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:=TextSheetOutName, FileFormat:=xlText
        Application.DisplayAlerts = True
    End If
    ActiveWorkbook.Close savechanges:=False
    Sheets(TextSheetOutName).Visible = False
    Exit Sub
OtherTextOutError:
    Application.StatusBar = False
    MsgBox "An error occurred during text file output. Make sure you click on one of the text output choices when you try the Text Output function again."
    Exit Sub
InvalidSave:
    MsgBox "File name and / or path is not valid!"
    Resume
    Exit Sub
End Sub
'
Sub List_Text_Sheets()
Attribute List_Text_Sheets.VB_ProcData.VB_Invoke_Func = " \n14"
    Dim TextSheetsNameArray() As String
    Dim Counter As Integer
    Dim Sht As Object
    Application.EnableCancelKey = xlDisabled
    Application.ScreenUpdating = False
    Counter = 0
    'Fill an array with the names of worksheets created for text output.
    '(i.e. with sheet name ending in '(Text)')
    On Error GoTo ListTextSheetsError
    ReDim TextSheetsNameArray(ActiveWorkbook.Worksheets.Count)
    For Each Sht In ActiveWorkbook.Worksheets
        If Right(Sht.Name, 6) = "(Text)" Then
            Counter = Counter + 1
            Let TextSheetsNameArray(Counter) = Sht.Name
        End If
    Next
    If Counter = 0 Then 'In case there are no text sheets.
        MsgBox "There must be at least one text sheet -- Text sheet names end in (Text). Make a text sheet and try the Text function again."
        'Reset in case failed during Update_Old_DB.
        Application.OnSheetActivate = ""
        Application.OnSheetActivate = Application.Workbooks("SDI Industry Data Interface.xla").Name & "!Utilities.Check_For_DB"
        End
    End If
    ReDim Preserve TextSheetsNameArray(Counter) 'Reset size to number found.
    'Reset dialog.
    Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("PickTextSheet").ListBoxes(1).List = TextSheetsNameArray
    Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("PickTextSheet").ListBoxes(1).Value = 1
    Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("PickTextSheet").EditBoxes(1).Text = TextSheetsNameArray(1)
    If Counter = 1 Then 'Let flop table function avoid dialog box.
        OnlyOneTextSheet = True
    End If
    Exit Sub
ListTextSheetsError:
    Application.StatusBar = False
    MsgBox "An error occurred while listing TEXT sheets. The database file structure may have been changed!"""
    End
End Sub


Attribute VB_Name = "Utilities"

Option Base 1
Public DBUpdatingName As String
'
Sub About_Interface()
    MsgBox "SDI Industry Data Interface Add-In. Revision 09/25/01." + Chr$(13) + Chr$(13) + _
     "© Copyright 1998, 1999, 2000, 2001 by Simulation Dynamics, Inc." + Chr$(13) + _
     "Phone: (865) 982-7046" + Chr$(13) + "http://www.SimulationDynamics.com" + Chr$(13) + _
     "E-Mail: Support@SimulationDynamics.com"
End Sub
'
' MAJOR MODIFICATIONS
' 5/21/99 AJS RandomDialog cosmetics, notes in Database Structure tab, renamed "ReNameMe Table" to "New Table".
' 5/27/99 RES Renamed "ReNameSheet" to "New Tab". Added code in Update_Old_DB to handle obscure range names.
' 5/27/99 RES (continued) Tables for Database Structure tab are flopped in new DB.
' 8/14/99 RES Added code to set 'DisplayAlerts' to 'True' after code termination throughout.
' 12/28/99 RES Fixed RandomDialog bug so parameters match the distribution selected.
' 12/28/99 RES Fixed alphabetical listing of tables in GOTOdialog.
' 1/15/00 RES Added functions to maintain indexed fields (parent-child relationships).
' 1/27/00 RES Added fix to be able to copy between workbooks for Excel 5.0 and 7.0.
' 1/30/00 RES Added indexed fields checks.
' 5/21/00 RES Added option to auto-restructure IndexedFields table.
' 5/26/00 RES Added DB edit option and menu hot keys.
' 5/28/00 RES Removed all code and objects related to transposed tables.
' 5/30/00 RES Changed to Excel Tabs table to replace old outline.
' 6/01/00 RES Renamed "New Sheet" to "New Tab".
' 6/02/00 RES Upgraded import text functions to allow import text to specify table tab.
' 12/20/00 RES Upgraded random setup. Added record and constrain functions.
' 12/20/00 RES Upgraded random setup for Emprical, Prime and UserStream distributions.
' 9/02/00 RES Fixed ability to import large tables and handle imported sheets with names beginning with key word "Unknown".
' 9/20/01 RES Added code to set invalid format codes to '0' ("General") and translate format code 71 to 80 on import.
' 9/25/01 RES Changed Indexed Fields table to be case insensitive.
'
Sub Auto_Open()
Attribute Auto_Open.VB_Description = "Makes the SDI Industry Data Interface menu accessible."
Attribute Auto_Open.VB_ProcData.VB_Invoke_Func = "D\n14"
    Dim MNU As Object
    Dim SDIAddIn As Object
    Application.EnableCancelKey = xlDisabled
    Delete_Ghost_Names
    On Error Resume Next
    'There must be at least one workbook open for menu and add-in preferences to work.
    If Workbooks.Count = 0 Then
        Workbooks.Add
    End If
    'Delete all existing DB menu(s).
    For Each MNU In MenuBars(xlWorksheet).Menus
        If MNU.Caption = "DB" Then
            MNU.Delete
        End If
    Next
    Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("Menu_Always_Present") = True
    Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("DB_Edit_Enabled") = True
    'Check every workbook activated.
    Application.OnSheetActivate = Application.Workbooks("SDI Industry Data Interface.xla").Name & "!Utilities.Check_For_DB"
    Check_For_DB
    'Ensure the Add-In is included in the Add-In list and is loaded.
    Set SDIAddIn = AddIns.Add(Filename:=Application.Workbooks("SDI Industry Data Interface.xla").Path & "\" & "SDI Industry Data Interface.xla")
    If Not SDIAddIn.Installed = True Then
        SDIAddIn.Installed = True
    End If
End Sub
'
Sub Build_Non_DB_Menu()
    Application.EnableCancelKey = xlDisabled
    On Error Resume Next
    'Delete old and add back new, empty menu.
    MenuBars(xlWorksheet).Menus("DB").Delete
    MenuBars(xlWorksheet).Menus.Add Caption:="D&B"
    'Add items and associated procedures.
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="&New DB Workbook", OnAction:="SDI Industry Data Interface.xla!New_DB_Workbook"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="&Menu Always Present", OnAction:="SDI Industry Data Interface.xla!Menu_Present_Preference"
    If Left(Application.Version, 1) = "7" Then
        MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="&Reset DB Menu", OnAction:="SDI Industry Data Interface.xla!Reset_DB_Menu"
    End If
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="-"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="&Help", OnAction:="SDI Industry Data Interface.xla!Show_Help"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="&About...", OnAction:="SDI Industry Data Interface.xla!About_Interface"
    'Set menu present option.
    If Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("Menu_Always_Present") = True Then
        MenuBars(xlWorksheet).Menus("DB").MenuItems("Menu Always Present").Checked = True
    Else
        MenuBars(xlWorksheet).Menus("DB").MenuItems("Menu Always Present").Checked = False
        MenuBars(xlWorksheet).Menus("DB").Delete
    End If
End Sub
'
Sub Build_DB_Menu()
    Application.EnableCancelKey = xlDisabled
    On Error Resume Next
    'Delete old and add back new, empty menu.
    MenuBars(xlWorksheet).Menus("DB").Delete
    MenuBars(xlWorksheet).Menus.Add Caption:="D&B"
    'Add items and associated procedures.
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="Go To &Selected Table", OnAction:="SDI Industry Data Interface.xla!Go_To_Selected_Table"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="&Go To Table...", OnAction:="SDI Industry Data Interface.xla!Go_To_Table"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="Re&turn to...", OnAction:="SDI Industry Data Interface.xla!Return_To_Table"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="-"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="Go To &Outline", OnAction:="SDI Industry Data Interface.xla!Go_To_Outline"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="-"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="Te&xt Output", OnAction:="SDI Industry Data Interface.xla!Menu_Text_Output"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="&Import Text", OnAction:="SDI Industry Data Interface.xla!Prepare_To_Import_Text"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="&Check All Child Field Entries", OnAction:="SDI Industry Data Interface.xla!Menu_Check_Entries_For_All_Child_Fields"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="-"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="R&estructure Selected Table", OnAction:="SDI Industry Data Interface.xla!Flop_Table"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="Restructure Multi&ple Tables", OnAction:="SDI Industry Data Interface.xla!Flop_Multiple_Tables"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="&Restructure ALL Tables", OnAction:="SDI Industry Data Interface.xla!Menu_Flop_All_Tables"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="-"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="T&able Properties", OnAction:="SDI Industry Data Interface.xla!Verify_Table_To_Edit_Table_Functions"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="Mo&ve Tables", OnAction:="SDI Industry Data Interface.xla!Move_Tables"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="Insert &User Table", OnAction:="SDI Industry Data Interface.xla!Insert_User_Table"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="DE&LETE User Table", OnAction:="SDI Industry Data Interface.xla!Delete_User_Table"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="Up&date Excel Tabs", OnAction:="SDI Industry Data Interface.xla!Update_Excel_Tabs_Table"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="-"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="&New DB Workbook", OnAction:="SDI Industry Data Interface.xla!New_DB_Workbook"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="&Menu Always Present", OnAction:="SDI Industry Data Interface.xla!Menu_Present_Preference"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="D&B Edit Enabled", OnAction:="SDI Industry Data Interface.xla!DB_Edit_Enabled_Preference"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="-"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="&Help", OnAction:="SDI Industry Data Interface.xla!Show_Help"
    MenuBars(xlWorksheet).Menus("DB").MenuItems.Add Caption:="About&...", OnAction:="SDI Industry Data Interface.xla!About_Interface"
    'Set DB edit and menu present options.
    If Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("DB_Edit_Enabled") = True Then
        MenuBars(xlWorksheet).Menus("DB").MenuItems("DB Edit Enabled").Checked = True
    Else
        MenuBars(xlWorksheet).Menus("DB").MenuItems("DB Edit Enabled").Checked = False
    End If
    If Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("Menu_Always_Present") = True Then
        MenuBars(xlWorksheet).Menus("DB").MenuItems("Menu Always Present").Checked = True
    Else
        MenuBars(xlWorksheet).Menus("DB").MenuItems("Menu Always Present").Checked = False
    End If
    MenuBars(xlWorksheet).Menus("DB").MenuItems("Re&turn to...").Enabled = False
End Sub
'
Sub Reset_DB_Menu()
    Application.EnableCancelKey = xlDisabled
    Application.CutCopyMode = False
    Check_For_DB
End Sub
'
Static Sub Check_For_DB()
    Dim SavedWorkingBookName As String
    Dim CurrentWorkingBookName As String
    Dim TestString As String
    Dim FoundDBMenu As Boolean
    Dim MenuCounter As Integer
    Dim MNU As Object
    Application.EnableCancelKey = xlDisabled
    On Error GoTo CheckForDBError
    '1/27/00 Add fix to be able to copy between workbooks for Excel 5.0 and 7.0.
    If Left(Application.Version, 1) = "7" And Application.CutCopyMode = 1 Then
        'Make sure only the one, correct DB menu is displayed.
        For Each MNU In MenuBars(xlWorksheet).Menus
            If MNU.Caption = "DB" Then
                MNU.Delete
            End If
        Next
        Set_Non_DB_Menus
        'Reset to normal double-click editing.
        Application.OnDoubleClick = ""
        Application.ScreenUpdating = True
        Exit Sub
    End If
    'Determine if user changed workbooks.
    SavedWorkingBookName = CurrentWorkingBookName
    CurrentWorkingBookName = ActiveWorkbook.Name
    If CurrentWorkingBookName = SavedWorkingBookName Then 'Same workbook.
        Exit Sub
    End If
    On Error GoTo 0
    On Error GoTo NotADB
    Set LocationInfo = Application.Workbooks("SDI Industry Data Interface.xla").Sheets("LocationInfo")
    LocationInfo.Range("Can_Return_To_Table") = "FALSE"
    'Test to see if the file is a DB. If not, the 'TestString' statements will produce an error.
    'Don't let the Add-In be a DB.
    If ActiveWorkbook.Name = "SDI Industry Data Interface.xla" Then
        Error 0 'A forced error.
    End If
    TestString = ActiveWorkbook.Sheets("Table Outline").Name 'Does it have a sheet named 'Table Outline'?
    TestString = ActiveWorkbook.Names("Field_Protection").Name 'Does it have a range named 'Field_Protection'?
    'Surely it's a DB!
    'Make sure only the one, correct DB menu is displayed.
    For Each MNU In MenuBars(xlWorksheet).Menus
        If MNU.Caption = "DB" Then
            MNU.Delete
        End If
    Next
    Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("IsDBWorkbook") = True
    Set_DB_Menus
    'Set the DB edit option.
    If Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("DB_Edit_Enabled") = True Then
        Application.OnDoubleClick = Application.Workbooks("SDI Industry Data Interface.xla").Name & "!EditTable.Enter_Edit_DB_Value"
        MenuBars(xlWorksheet).Menus("DB").MenuItems("DB Edit Enabled").Checked = True
    Else
        Application.OnDoubleClick = ""
        MenuBars(xlWorksheet).Menus("DB").MenuItems("DB Edit Enabled").Checked = False
    End If
    On Error GoTo 0
    Test_For_Old_DB
    Application.ScreenUpdating = True
    Exit Sub
CheckForDBError:
    MsgBox "An error occurred while checking for DB!"
    Exit Sub
NotADB:
    Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("IsDBWorkbook") = False
    Set_Non_DB_Menus
    'Reset to normal double-click editing.
    Application.OnDoubleClick = ""
    Application.ScreenUpdating = True
    Exit Sub
End Sub
'
Sub Set_DB_Menus()
    Application.EnableCancelKey = xlDisabled
    On Error GoTo SetDBMenu
    'Check if DB menu is already set.
    If MenuBars(xlWorksheet).Menus("DB").MenuItems(2).Caption = "Go To Table..." Then
        Exit Sub
    End If
SetDBMenu:
    Build_DB_Menu
End Sub
'
Sub Set_Non_DB_Menus()
    Application.EnableCancelKey = xlDisabled
    On Error GoTo SetNonDBMenu
    'Check if non-DB menu is already set.
    If MenuBars(xlWorksheet).Menus("DB").MenuItems(2).Caption = "Menu Always Present" Then
        Exit Sub
    End If
SetNonDBMenu:
    Build_Non_DB_Menu
End Sub
'
Sub Test_For_Old_DB()
    Dim TestString As String
    Dim UpdateDialog As Object
    Static OldWorkingBookName As String
    Static NewWorkingBookName As String
    Dim PassedFirstOldOutlineCheck As Boolean
    Dim PassedSecondOldOutlineCheck As Boolean
    Application.EnableCancelKey = xlDisabled
    'Determine if user changed workbooks.
    OldWorkingBookName = NewWorkingBookName
    NewWorkingBookName = ActiveWorkbook.Name
    If NewWorkingBookName = OldWorkingBookName Then 'Same workbook.
        Exit Sub
    End If
    On Error GoTo NoOldDBcode
    Set UpdateDialog = Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("UpdateDialog")
    'Check to see if DB has old code and needs to be updated. If not, the 'TestString' statements will produce an error.
    TestString = ActiveWorkbook.Sheets("FormatCodes").Name 'Does it have a sheet named 'FormatCodes'?
    TestString = ActiveWorkbook.Names("Formats_Top").Name 'Does it have a range named 'Formats_Top'?
    'Surely it has old DB code!
    'Initialize dialog. Default is make backup.
    DBUpdatingName = ActiveWorkbook.Name
    UpdateDialog.Labels(1).Text = _
     "The installed SDI Industry Data Interface Add-In no longer requires the Excel VBA code in this workbook. Proceed with update of '" & DBUpdatingName & "'?"
    UpdateDialog.CheckBoxes(1).Text = "Create backup file '" & Left(DBUpdatingName, Len(DBUpdatingName) - 4) & ".bak'"
    UpdateDialog.CheckBoxes(1).Value = xlOn
    If Not UpdateDialog.Show Then
        MsgBox "File was left untouched."
        Exit Sub
    End If
    'If selected, save backup file.
    On Error GoTo 0
    On Error GoTo CantSaveBackup
    If UpdateDialog.CheckBoxes(1).Value = xlOn Then
        ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & Left(DBUpdatingName, Len(DBUpdatingName) - 4) & ".bak"
    End If
    Application.OnTime Now, "Update_Old_DB"
    Exit Sub
NoOldDBcode:
    'Check for old outline.
    On Error Resume Next
    PassedFirstOldOutlineCheck = False
    PassedSecondOldOutlineCheck = False
    'Look for two unusual/unique defined names.
    For Each NM In ActiveWorkbook.Names
        If NM.Name = "Table_List_Bottom_Row" Then
            PassedFirstOldOutlineCheck = True
        End If
        If NM.Name = "Table_List_Alpha_Top" Then
            PassedSecondOldOutlineCheck = True
        End If
    Next
    If PassedFirstOldOutlineCheck And PassedSecondOldOutlineCheck Then
        Application.OnTime Now, "Create_New_Outline"
    End If
    Exit Sub
CantSaveBackup:
    MsgBox "The backup file could not be saved! A network connection may have been lost or other system change may have occured."
    MsgBox "Find the cause and re-open the old DB file."
    End
End Sub
'
Sub Auto_Close()
    Application.EnableCancelKey = xlDisabled
    On Error Resume Next
    MenuBars(xlWorksheet).Menus("DB").Delete
    Application.OnSheetActivate = ""
    'Reset to normal double-click editing.
    Application.OnDoubleClick = ""
End Sub
'
Sub Delete_Ghost_Names()
    Dim NM As Object
    Application.EnableCancelKey = xlDisabled
    On Error Resume Next
    'Delete names that might create links.
    For Each NM In ActiveWorkbook.Names
        If Right(NM.Name, 9) = "GOTO_List" And Not NM.Name = "GOTO_List" Or Right(NM.Name, 14) = "GOTO_List_Name" And Not NM.Name = "GOTO_List_Name" Then
            NM.Delete
        End If
    Next
End Sub
'
Sub Menu_Present_Preference()
    Dim MenuPresent As Object
    Application.EnableCancelKey = xlDisabled
    On Error Resume Next
    Set MenuPresent = Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("Menu_Always_Present")
    'Change variable and set menus.
    If MenuPresent Then
        MenuPresent = False
    Else
        MenuPresent = True
    End If
    If Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("IsDBWorkbook") = True Then
        Build_DB_Menu
    Else
        Build_Non_DB_Menu
    End If
End Sub
'
Sub DB_Edit_Enabled_Preference()
    Application.EnableCancelKey = xlDisabled
    On Error Resume Next
    If Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("DB_Edit_Enabled") = True Then
        Application.OnDoubleClick = ""
        Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("DB_Edit_Enabled") = False
        MenuBars(xlWorksheet).Menus("DB").MenuItems("DB Edit Enabled").Checked = False
    Else
        Application.OnDoubleClick = Application.Workbooks("SDI Industry Data Interface.xla").Name & "!EditTable.Enter_Edit_DB_Value"
        Application.Workbooks("SDI Industry Data Interface.xla").Sheets("Interfaces").Range("DB_Edit_Enabled") = True
        MenuBars(xlWorksheet).Menus("DB").MenuItems("DB Edit Enabled").Checked = True
    End If
End Sub
'
Sub Show_Help()
    Dim PathString As String
    Application.EnableCancelKey = xlDisabled
    On Error Resume Next
    PathString = Application.Workbooks("SDI Industry Data Interface.xla").Path
    If InStr(1, PathString, "\Extensions\SDI", 1) > 0 Then
        PathString = Left(PathString, Len(PathString) - Len("\Extensions\SDI")) & "\Help"
    End If
    Application.Help PathString & "\" & "SDI INDUSTRY HELP.hlp"
End Sub


Attribute VB_Name = "Update"

Option Base 1
Public ExcelTabsNameCell As Object 'The cell that contains the Excel Tabs table name.
Public ExcelTabsTopFieldCell As Object
Public ExcelTabsBottomFieldCell As Object
Public ExcelTabsRecordsArea As Object 'The first column of the row(s) that comprise the Excel Tabs table.
Public ExcelTabsFirstFieldCell As Object
Public ExcelTabsLastFieldCell As Object
Public ExcelTabsFieldsArea As Object
Public ExcelTabsTabs As Object
Public ExcelTabsTables As Object
'
Public MakeUpdatingFile As Boolean
Public SaveIndexedFieldsSheetName As String
Dim SheetName As String
Dim LastColumn As Integer
Dim LastRow As Single
'
Dim SheetCounter As Integer
'
Sub Update_Excel_Tabs_Table()
    Dim ExcelTabsTabsArray() As String
    Dim ExcelTabsTablesArray() As String
    Dim ArrayIndex As Integer
    Dim SheetHasTables As Boolean
    Dim FirstTableFound As Object
    Dim CurrentTableFound As Object
    Dim ResizedExcelTabs As Boolean
    Dim C As Object
    Application.EnableCancelKey = xlDisabled
    Application.ScreenUpdating = False
    List_User_Sheets 'Fills an array named 'UserSheetsNameArray'.
    ReDim ExcelTabsTabsArray(UserSheetCounter * 10)
    ReDim ExcelTabsTablesArray(UserSheetCounter * 10)
    'Fill Excel Tabs arrays with sheet names and corresponding table names.
    Application.StatusBar = "Listing tabs and corresponding tables..."
    ArrayIndex = 0
    SheetCounter = 1
    On Error GoTo NoTablesOnThisSheet
    Do Until SheetCounter > UserSheetCounter
        'Activate each user sheet and look for tables.
        Sheets(UserSheetsNameArray(SheetCounter)).Activate
        'Look for first table.
        SheetHasTables = True
        Columns("A:A").Find(what:="Table", after:=Range("A1"), LookIn:=xlValues, _
         LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
         MatchCase:=False).Activate
        If SheetHasTables Then
            Set FirstTableFound = ActiveCell
            ArrayIndex = ArrayIndex + 1
            Do While True
                Set CurrentTableFound = ActiveCell
                ActiveCell.Offset(0, 2).Select
                Let ExcelTabsTabsArray(ArrayIndex) = ActiveSheet.Name
                Let ExcelTabsTablesArray(ArrayIndex) = ActiveCell.Value
                'Look for more tables.
                ActiveSheet.Columns("A:A").Find(what:="Table", after:=CurrentTableFound, LookIn:=xlValues, _
                 LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                 MatchCase:=False).Activate
                If FirstTableFound.Address = ActiveCell.Address Then
                    GoTo NoMoreTablesOnThisSheet
                Else
                    ArrayIndex = ArrayIndex + 1
                End If
            Loop
        End If
NoMoreTablesOnThisSheet:
        SheetCounter = SheetCounter + 1
    Loop
    On Error GoTo 0
    On Error GoTo MessedUpOutline
    ReDim Preserve ExcelTabsTabsArray(ArrayIndex) 'Reset size to number of tables found.
    ReDim Preserve ExcelTabsTablesArray(ArrayIndex) 'Reset size to number of tables found.
    Application.StatusBar = False
    'Resize Excel Tabs table bases on the number of tables found, if needed.
    Sheets("Table Outline").Activate
    Define_Excel_Tabs_Table
    ResizedExcelTabs = False
    If ArrayIndex <> ExcelTabsRecordsArea.Rows.Count Then
        Application.StatusBar = "Resizing Excel Tabs..."
        'Delete all Excel Tabs rows except for the first record.
        If ExcelTabsRecordsArea.Rows.Count > 1 Then
            Sheets("Table Outline").Range(ExcelTabsTopFieldCell.Offset(1, 0), ExcelTabsBottomFieldCell).EntireRow.Delete
        End If
        Define_Excel_Tabs_Table
        ExcelTabsTopFieldCell.Value = 1
        ExcelTabsTopFieldCell.Offset(0, 2).Value = ""
        ExcelTabsTopFieldCell.Offset(0, 3).Value = ""
        ExcelTabsFieldsArea.Offset(1, 0).Borders(xlBottom).LineStyle = xlNone
        If ArrayIndex > 1 Then
            'Add a row with the first record formula.
            ExcelTabsBottomFieldCell.EntireRow.Copy
            ExcelTabsBottomFieldCell.EntireRow.Offset(1, 0).Insert Shift:=xlDown
            ExcelTabsBottomFieldCell.Offset(1, 0).FormulaR1C1 = "=R[-1]C+1"
        End If
        If ArrayIndex > 2 Then
            'Add enough rows for all user tables in the DB.
            ExcelTabsBottomFieldCell.Offset(1, 0).EntireRow.Copy
            ExcelTabsBottomFieldCell.Offset(2, 0).Rows("1:" & ArrayIndex - 2).EntireRow.Insert Shift:=xlDown
        End If
        Define_Excel_Tabs_Table
        'Restore the bottom border on the last row.
        With ExcelTabsFieldsArea.Offset(ExcelTabsRecordsArea.Rows.Count, 0).Borders(xlBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        ResizedExcelTabs = True
        Application.StatusBar = False
    End If
    'Use the arrays to fill the Excel Tabs table.
    Application.StatusBar = "Filling Excel Tabs..."
    ArrayIndex = 1
    For Each C In ExcelTabsTabs
        C.Value = ExcelTabsTabsArray(ArrayIndex)
        C.Offset(0, 1).Value = ExcelTabsTablesArray(ArrayIndex)
        ArrayIndex = ArrayIndex + 1
    Next
    Application.StatusBar = False
    If ResizedExcelTabs Then
        'Automatically restructure the Excel Tabs table.
        Application.Workbooks("SDI Industry Data Interface.xla").DialogSheets("GOTODialog").EditBoxes(1).Text = "Excel Tabs"
        FloppingManyTables = True
        FindingRemoteTable = False
        GoToDialogTable = True
        Pick_Text_Sheet
        WantToCheckChildFields = False
        TextTableErrors = 0 'Reset text table error counter.
        TextFormatCodeErrors = 0 'Reset text table format code error counter.
        Find_The_Table
        Flop_Table
        Sheets(TextSheetName).Visible = False
    End If
    Sheets("Table Outline").Activate
    Reset_Globals
…