********************************** 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 **********************************