Issue No. 14 (November 1, 1999)

[Item URL]

**********************************

COMMENTS

Welcome to the 14th issue of the Excel Experts E-letter (or EEE), by 
David Hager. EEE is a semi-monthly publication. Feel free to distribute
copies of EEE to your friends and colleagues. 

Back issues are available for download from the EEE web page located on 
John Walkenbach's web site. New issues are normally available on the 1st 
and 16th of each month. There will be periods when EEE is not published 
due to time and travel constraints.

http://www.j-walk.com/ss/excel/eee/index.htm


**********************************

TOP EXCEL WEB SITES

See:

http://www.appspro.com

for a group of great free Excel utilities that have finally found a home.


**********************************

POWER FUNCTION TECHNIQUE

by Stephen Bullen and David Hager

These functions are modifications of an user-defined function made by 
Stephen Bullen and published in the Feb'99 issue of PC World magazine.
All of these functions are primarily designed to be used as a condition
for conditional formatting, as they are meant to be used with a single
cell range. When used with multi-cell ranges, these functions will return
True if the range argument intersects the filter range. Determining if
the range argument is a subset of the filter range would require the
comparison of the intersection of the range argument and the filter range 
to see if it was equal to the range argument.

Function InFilterList(Rng As Range) As Boolean
    On Error GoTo TheEnd
    InFilterList = False
      If Not Intersect(Rng, Rng.Parent.AutoFilter.Range) _
      Is Nothing Then
            InFilterList = True
      End If
    Exit Function
TheEnd:
End Function

The InFilterList function returns True if the range in question is
located in a filter range. This is the range where the Data, AutoFilter
has been applied but no criteria has been chosen. The act of adding
or removing the autofilter does not cause a recalculation of this
function when it is used in a conditional formatting formula. Thus,
a recalculation on the worksheet is needed for the conditional format
to be applied.

Function InFilteredList(Rng As Range) As Boolean
    On Error GoTo TheEnd
    InFilteredList = False
    With Rng.Parent.AutoFilter
      If Not Intersect(Rng, .Range) Is Nothing Then
      For n = 1 To .Range.Columns.Count
        If .Filters(n).On Then
            InFilteredList = True
            Exit For
        End If
      Next
      End If
    End With
    Exit Function
TheEnd:
End Function

The InFilteredList function returns True if the range in question is
located in a filtered range. Since the application of the filter is
recognized by Excel as a change requiring a recalculation, this function 
will afford dynamic formatting changes to cells when used in conjunction
with conditional formatting. 

Function InFilteredField(Rng As Range) As Boolean
    On Error GoTo TheEnd
    InFilteredField = False
    With Rng.Parent.AutoFilter
      If Not Intersect(Rng, .Range) Is Nothing Then
        If .Filters(Rng.Column - .Range.Column + 1).On Then
            InFilteredField = True
        End If
      End If
    End With
    Exit Function
TheEnd:
End Function

The InFilteredField function returns True if the range in question is
located in a column to which a filter has been applied. If the entire
filter range has been conditionally formatted, all of the columns that
have a set criteria will display the desired formatting.

**********************************

VBA CODE EXAMPLES 

by Stephen Bullen

This procedure delinks all of the charts in a workbook.

Sub RemoveChartLinks()

Dim oSht As Worksheet, oCht As ChartObject, oSeries As Series

'From all embedded charts
For Each oSht In ActiveWorkbook.Worksheets
    For Each oCht In oSht.ChartObjects
        For Each oSeries In oCht.Chart.SeriesCollection
            With oSeries
                .Name = .Name
                .Values = .Values
                .XValues = .XValues
            End With
        Next
    Next
Next

'From all chart sheets
For Each oCht In ActiveWorkbook.Charts
    For Each oSeries In oCht.SeriesCollection
        With oSeries
            .Name = .Name
            .Values = .Values
            .XValues = .XValues
        End With
    Next
Next

End Sub


by Jim Rech

This procedure opens an application through the use of the Shell function 
and it allows for the lag time involved with the opening process.

Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
   ByVal bInheritHandle As Long, _
    ByVal dwProcessId As Long) As Long

Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, _
   lpExitCode As Long) As Long

Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const STILL_ACTIVE = &H103

Sub Test()
    Dim StartTime As Double
    StartTime = Now
    ShellAndWait "calc.exe", 1
    MsgBox "Gone " & Format(Now - StartTime, "s") & " seconds"
End Sub

'Window States (Per Help for Shell function):
'   1, 5, 9 Normal with focus.
'   2   Minimized with focus.
'   3   Maximized with focus.
'   4, 8 Normal without focus.
'   6, 7 Minimized without focus.
Sub ShellAndWait(ByVal PathName As String, Optional WindowState)
    Dim hProg As Long
    Dim hProcess As Long, ExitCode As Long

    'fill in the missing parameter and execute the program
    If IsMissing(WindowState) Then WindowState = 1
    hProg = Shell(PathName, WindowState)
    'hProg is a "process ID under Win32. To get the process handle:
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)
    Do
    'populate Exitcode variable
        GetExitCodeProcess hProcess, ExitCode
        DoEvents
    Loop While ExitCode = STILL_ACTIVE
End Sub


by Jim Rech

This procedure removes all code and related structures from a workbook.

''Needs a reference to the VB Extensibility library set

'Removes from active workbook all:
 ''Regular modules
 ''Class modules
 ''Userforms
 ''Code in sheet and workbook modules
 ''Non built-in references
 ''Excel 4 macro sheets
 ''Dialog sheets

Sub RemoveAllCode()
    'XL2K:
    'Dim VBComp As VBComponent, AllComp As VBComponents, ThisProj As
    VBProject
    'XL97 & XL2K:
    Dim VBComp As Object, AllComp As Object, ThisProj As Object
    Dim ThisRef As Reference, WS As Worksheet, DLG As DialogSheet
    If ActiveWorkbook.Name <> ThisWorkbook.Name Then
        Set ThisProj = ActiveWorkbook.VBProject
        Set AllComp = ThisProj.VBComponents
        For Each VBComp In AllComp
            With VBComp
                Select Case .Type
                    Case vbext_ct_StdModule, vbext_ct_ClassModule, _
			vbext_ct_MSForm
                        AllComp.Remove VBComp
                    Case vbext_ct_Document
                        .CodeModule.DeleteLines 1, .CodeModule.CountOfLines
                End Select
            End With
        Next
        For Each ThisRef In ThisProj.References
            If Not ThisRef.BuiltIn Then ThisProj.References.Remove ThisRef
        Next
    End If
    Application.DisplayAlerts = False
    For Each WS In Excel4MacroSheets
        WS.Delete
    Next
    For Each DLG In DialogSheets
        DLG.Delete
    Next
End Sub


**********************************

POWER PROGRAMMING TECHNIQUES

by David Hager

Data normalization is a task that is commonly applied in a variety
of data workups.  When normalized, the sum of the data equals some
value that is set by an arbitrary or real constraint. In Excel, the
normalization process is accomplished with a column (or row) of
formulas appropriate to the task. The following technique provides
a way to convert data to a normalized form without the use of
formulas. 

Sub NormalizeRangeValues(Optional nRange As String, _
    Optional nValue As Double = 1)
    If nRange = "" Then
        nRange = Selection.Address
    End If
    nSum = Application.WorksheetFunction.Sum(Range(nRange))
    If nSum = 0 Then Exit Sub
    For Each nCell In Range(nRange)
        With nCell
            If .Value <> "" Then
                .Value = (nValue / nSum) * .Value
            End If
        End With
    Next
End Sub


Sub NormalizeTableValues(tRange As String, _
        Optional nVal As Double = 1, Optional CoR As Boolean = True)
    Dim n As Integer
    If CoR Then
      CoR_Count = Range(tRange).Columns.Count
    Else
      CoR_Count = Range(tRange).Rows.Count
    End If
    For n = 1 To CoR_Count
        NormalizeRangeValues RangeSection(tRange, n, CoR), nVal
    Next
End Sub

Function RangeSection(tRange As String, _
         posNum As Integer, Optional ByCol As Boolean = True) As String
         Dim cOffset As Integer
         Dim rOffset As Integer
         Dim cSize As Integer
         Dim rSize As Integer
         cOffset = 0
         rOffset = 0
         cSize = 1
         rSize = 1
         Set mRange = Range(tRange)
         If ByCol Then
            cOffset = posNum - 1
            rSize = mRange.Rows.Count
         Else
            rOffset = posNum - 1
            cSize = mRange.Columns.Count
         End If
         Set sRange = mRange.Offset(rOffset, cOffset).Resize(rSize, cSize)
         RangeSection = sRange.Address
End Function

Apart from its use with the normalization technique, the RangeSection 
function can be useful for returning the address of a row or column within 
a specified range. The function is constructed to return a string, but it 
can just as easily be made to return a Range object.

Sub RunNormalizeTable()
   Application.EnableEvents = False
   NormalizeTableValues Selection.Address, 2.5, False
   Application.EnableEvents = False
End Sub

The procedure shown above will normalize the data in all of the rows in 
a selected data table to a value of 2.5.

When writing a procedure that incorporates a general utility macro, 
it is a good idea to disable/enable events in that procedure if it 
triggers an event that is not inherent to the function of that utility.
In the case of using the NormalizeRangeValues function, the cell values
are changed, so that will start any application, workbook or worksheet
level change event for each cell changed. If those event procedures 
contain code, that code will run with each change, which may not be
the desired outcome.



by David Hager

The following event procedures work together to place the contents of a cell 
into a cell comment when another entry is made. For example, if a cell 
contains a value of 13, and 23 is entered in the cell, the cell comment will 
contain the statement:

"Previous entry was 13"

Public acVal

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    On Error Resume Next
    Target.AddComment
    Target.Comment.Text "Previous entry was " & acVal
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    If ActiveCell.Address <> Target.Address Then Exit Sub
    If Target.Value = "" Then
    	acVal = "" 
    Else
    	acVal = Target.Value
    End If
End Sub

The cell value is stored in a public variable when a cell is selected. Then, 
when a new value is added, the Worksheet_Change event procedure adds a cell 
comment (the error generated if the cell already has a comment is stepped 
over) and then uses the stored variable as part of the text string for the 
comment. This technique could be easily modified to add all of the changes 
made to a cell over time to the comment.



**********************************

Issue No.14 OF EEE (PUBLISHED 01Nov1999)
Next issue scheduled for 16Nov1999.
BY David Hager
dchager@compuserve.com

**********************************