'#Reference {F64FEA84-AF63-11D0-81CE-444553540000}#1.0#0#SUCCESSDB.DLL#US Cost SuccessDB Object Library v1.0
Sub Main()
'
'
' TreeLevels_DeleteZeroCost
'
' This macro will delete all levels in the active project's active tree that
' do not contain any costs.
'
' Version 1.0 (9-23-1999)
'
' Copyright (C)1990-1999 U.S. COST, Inc.
'
' Permission to use, copy, modify, and distribute this software for any purposes
' and without fee is hereby granted, provided that the above copyright notice appears
' in all copies and that both the copyright notice and the limited warranty and
' restricted rights notice below appear in all supporting documentation
'
' U.S. COST PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS. U.S. COST SPECIFICALLY
' DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTIBILITY OR FITNESS FOR A PARTICULAR USE.
' U.S. COST, INC. DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
' UNINTERRUPTED OR ERROR FREE.
'
'
On Error GoTo ErrorHandler

Dim objSuccessApp As Object
Dim objDocument As Object
Dim objProject As Object
Dim objTree As Object
Dim lngSelectedTree As Long

	Set objSuccessApp = CreateObject("Success.Application.1")
	
	If objSuccessApp.Documents.Count > 0 Then

    	Set objDocument = objSuccessApp.ActiveDocument
    	Set objProject = objDocument.Project

    	If Not objProject.IsTotaled Then
    
       		MsgBox "The active project has not been totaled.",,"Error"
    
       		Set objSuccessApp = Nothing
       		Set objDocument = Nothing
       		Set objProject = Nothing
       		Set objTree = Nothing
 
       		Exit Sub

    	End If

        lngSelectedTree = objDocument.SelectedTree
   
        Set objTree = objProject.Trees(lngSelectedTree - 1)

    	RemoveZeroCostTreeLevels objTree.TreeLevels
    
    	objDocument.Refresh

    	MsgBox "All zero-cost levels have been removed.",, "Delete Zero Cost Levels"
    
    Else
 
     	MsgBox "A project must be opened.",,"Error"	
 
    End If
    
    Set objSuccessApp = Nothing
    Set objDocument = Nothing
    Set objProject = Nothing
    Set objTree = Nothing

Exit Sub

ErrorHandler:
    
    If Err.Number = 440 Then
        
        MsgBox "An OLE Automation error occurred.",,"Error"
        
    Else
        
        MsgBox Err.Number + 28765 & ": " & Err.Description,, "Error"
        
    End If

    Set objSuccessApp = Nothing
    Set objDocument = Nothing
    Set objProject = Nothing
    Set objTree = Nothing

End Sub

Sub RemoveZeroCostTreeLevels(objInLevels As Object)
Dim objInLevel As Object
Dim intLevelCount As Integer
Dim intLevel As Integer

    intLevelCount = objInLevels.Count
    
    If intLevelCount > 0 Then
    
        For intLevel = intLevelCount - 1 To 0 Step -1
        
            Set objInLevel = objInLevels(intLevel)
            
            If objInLevel.TotalCost.Total = 0 Then
            
                objInLevel.Parent.Remove objInLevel
                DoEvents
            
            Else
                
                RemoveZeroCostTreeLevels objInLevel.TreeLevels
            
            End If
        
        Next intLevel
    
    End If
    
    Set objInLevel = Nothing
    
End Sub