Issue No. 16 (January 31, 2000)

[Item URL]

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

COMMENTS

Welcome to the 16th issue of the Excel Experts E-letter (or EEE), by 
David Hager. EEE is now a 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 
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

Note: The index for issues 11-15 is at the end of this E-letter.

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

TOP EXCEL WEB SITES

Visit Chip Pearson's growing and everchanging Excel web site at:

http://www.cpearson.com

A new addition to his site are two interesting Excel games 
(free with unprotected source code) made by yours truly.

http://www.cpearson.com/excel/games.htm


This web page provides a wealth of diverse Excel information.

http://www.mathtools.net/Excel/index.html

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

WORKSHEET FORMULA TIP

by Harlan Grove

Needed: A formula to determine if the items contained in Range1 are 
contained in Range2. If not, then a comparison of Range1 will be made 
to another range and so on. For example:

Range1:
 A       B       C
PEAR    APPLE  ORANGE

Range2:
 A       B       C       D
PEAR    APPLE   ORANGE  BANANA
 
To check if everything in Range1 appears in Range2, you could use this 
array formula:

=AND(NOT(ISNA(MATCH(Range1,Range2,0))))

Trickier: if all single row ranges to check Range1 against are collected 
into a single table, for example, Range 3 as

pear    mango   orange
pear    mango   grapes  banana  dates
pear    grapes  orange  banana
grapes  mango   orange  banana
pear    apple   grapes  banana  dates   figs
apple   pear    orange  banana
grapes  apple   orange  banana
pear    apple   orange  banana  dates   figs    cheries

then the following array function will return the row index of the first 
(topmost) row in which there's a match for all entries in Range1: 

=MATCH(COLUMNS(Range1),MMULT(COUNTIF(Range1,Range3),
TRANSPOSE(COLUMN(Range3)^0)),0)

which takes advantage of COUNTIF's peculiar semantics when both of its 
arguments are arrays. This formula returns 6.


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

POWER FORMULA TECHNIQUE

by David Hager

This array formula returns TRUE if the number in cell A1 is a Fibonacci 
number. A Fibonacci number is a member of the number series 1,1,2,3,5,8
13,21,34,55,89,... which is intimately linked to a variety of growth
and life processes.

=OR(A1=ROUND((((SQRT(5)+1)/2)^ROW(1:73))/SQRT(5),0))


by Harlan Grove

This formula is a general two dimensional array reshaping formula for an 
array of size NewRows x NewCols, similar to APL's RHO array, that works 
for any worksheet array A.

=N(OFFSET(A,MOD(INT(((ROW(INDIRECT("1:"&NewRows))-1)*NewCols+
TRANSPOSE(ROW(INDIRECT("1:"&NewCols))-1))/COLUMNS(A)),
ROWS(A)),MOD(((ROW(INDIRECT("1:"&NewRows))-1)*NewCols+
TRANSPOSE(ROW(INDIRECT("1:"&NewCols))-1)),COLUMNS(A)),1,1))

For example, if A is {11,12;21,22;31,32;41,42;51,52;61,62}, NewRows has
value 5 and NewCols has value 3, this formula gives
{11,12,21;22,31,32;41,42,51;52,61,62;11,12,21}.


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


VBA CODE EXAMPLES 

by David Hager

Use the first function to read a range from a closed workbook into an 
array and the second procedure for direct input into a range on the 
active worksheet.

'CWRIA is short for ClosedWorkbookRangeIntoArray

Function CWRIA(fPath As String, fName As String, sName As String, _
	     rng As String)
    Dim sRow As Integer
    Dim sColumn  As Integer
    Dim sRows As Integer
    Dim sColumns  As Integer
    Dim vrow As Integer
    Dim vcol  As Integer
    Dim fpStr As String
    Dim cArr()
    On Error GoTo NoArr
    If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
    If Dir(fPath & fName) = "" Then
        CWA = CVErr(xlErrValue)
        Exit Function
    End If
    sRow = Range(rng).Row
    sColumn = Range(rng).Column
    sRows = Range(rng).Rows.Count
    sColumns = Range(rng).Columns.Count
    ReDim cArr(sRows, sColumns)
    For vrow = 1 To sRows
        For vcol = 1 To sColumns
            fpStr = "'" & fPath & "[" & fName & "]" & sName & "'!" & _
            "r" & sRow + vrow - 1 & "c" & sColumn + vcol - 1
            cArr(vrow, vcol) = ExecuteExcel4Macro(fpStr)
        Next
    Next
    CWRIA = cArr
    Exit Function
NoArr:
    CWRIA = CVErr(xlErrValue)
End Function


'CWRIR is short for ClosedWorkbookRangeIntoArray

Sub CWRIR(fPath As String, fName As String, sName As String, _
	     rng As String, destRngUpperLeftCell As String )
    Dim sRow As Integer
    Dim sColumn  As Integer
    Dim sRows As Integer
    Dim sColumns  As Integer
    Dim vrow As Integer
    Dim vcol  As Integer
    Dim fpStr As String
    Dim cArr()
    On Error GoTo NoArr
    If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
    If Dir(fPath & fName) = "" Then
        CWA = CVErr(xlErrValue)
        Exit Function
    End If
    sRow = Range(rng).Row
    sColumn = Range(rng).Column
    sRows = Range(rng).Rows.Count
    sColumns = Range(rng).Columns.Count
    ReDim cArr(sRows, sColumns)
    Set destRange = ActiveSheet.Range(destRngUpperLeftCell) 
    For vrow = 1 To sRows
        For vcol = 1 To sColumns
            fpStr = "'" & fPath & "[" & fName & "]" & sName & "'!" & _
            "r" & sRow + vrow - 1 & "c" & sColumn + vcol - 1
            destRange.Offset(vrow - 1, vcol - 1) = ExecuteExcel4Macro(fpStr)
        Next
    Next
NoArr:
End Sub

The following procedure copies the values from the range A1:C3 from Sheet1 of
the closed workbook cellDataVal.xls located at D:\EXCEL97\xlformulas to the
range F9:H11 on the active worksheet.   

Sub InsertRangeFromClosedWorkbook()
    CWRIR "D:\EXCEL97\xlformulas", "cellDataVal.xls", "Sheet1", _
    "a1:c3", "f9"
End Sub


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

POWER PROGRAMMING TECHNIQUES

by xxxxxx

Here is a method for counting instances of Excel application and storing
the handles for each instance in an array. 

Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA"(ByVal 
lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow"(ByVal 
hwnd As Long, ByVal wFlag As Long) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA"(ByVal
hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long


Private Const GW_HWNDNEXT = 2


Sub xlInstances()

  Dim hwnd As Long, lRet As Long
  Dim hWndArray() As Long
  Dim i As Integer
  Dim sClassBuffer As String

  i = 0
  hwnd = FindWindow("XLMAIN", vbNullString)
  If hwnd <> 0 Then
    ReDim hWndArray(i)
    hWndArray(i) = hwnd
    Do
      hwnd = GetNextWindow(hwnd, GW_HWNDNEXT)
      If hwnd = 0 Then Exit Sub
      sClassBuffer = String(255, 0)
      lRet = GetClassName(hwnd, sClassBuffer, Len(sClassBuffer))
      sClassBuffer = Left(sClassBuffer, InStr(1, sClassBuffer, Chr(0),
      vbTextCompare) - 1)
      If UCase(sClassBuffer) = "XLMAIN" Then
        i = i + 1
        ReDim Preserve hWndArray(i)
        hWndArray(i) = hwnd
      End If
    Loop
  End If

End Sub

Keep the Array hWndArray global, so that you can access it outside the search
function. The handle is valid as long as the instance exists and will die if 
you quit Excel.


by Tom Ogilvy and David Braden

A FAST method for building an unique list from data in column A.

Sub BuildUnique1()
Dim vArr As Variant
Dim vArr1 As Variant
Set RNG = Range(Cells(1, "A"), Cells(1, "A"). End(xlDown))
vArr = Application.Transpose(RNG)
ShellSort vArr
ReDim vArr1(1 To 1)
vArr1(1) = vArr(1)
j = 1
For i = LBound(vArr, 1) + 1 To UBound(vArr, 1)
If vArr(i) <> vArr1(j) Then
   j = j + 1
   ReDim Preserve vArr1(1 To j)
   vArr1(j) = vArr(i)
End If
Next
End Sub

Using David Braden's implementation of ShellSort:

Sub ShellSort(list As Variant, Optional ByVal LowIndex As Variant, Optional
HiIndex As Variant)
   'Translation of Shell's Sort as described in
   ' "Numerical Recipes in C", 2nd edition, Press et al.
   'For large arrays, consider Quicksort. This algorithm is at least
   'as good up to about 100 or so elements. But with 500 randomized
   'elements it is about 27% slower than QSort, and looks
   'increasingly worse as the array size increases.

   'Dec 17, '98 - David J. Braden

   Dim i As Long, j As Long, inc As Long
   Dim var As Variant

   If IsMissing(LowIndex) Then LowIndex = LBound(list)
   If IsMissing(HiIndex) Then HiIndex = UBound(list)
   inc = 1
   Do While inc <= HiIndex - LowIndex: inc = 3 * inc + 1: Loop
   Do
      inc = inc \ 3
      For i = LowIndex + inc To HiIndex
         var = list(i)
         j = i
         Do While list(j - inc) > var
            list(j) = list(j - inc)
            j = j - inc
            If j <= inc Then Exit Do
         Loop
         list(j) = var
      Next
   Loop While inc > 1
End Sub


by Laurent Longre

VBA code for placing a shortcut on the desktop.

Declare Function SHGetSpecialFolderLocation Lib "Shell32" _
  (ByVal hwnd As Long, ByVal nFolder As Long, ppidl As Long) As Long

Declare Function SHGetPathFromIDList Lib "Shell32" _
  (ByVal Pidl As Long, ByVal pszPath As String) As Long

Declare Function SetWindowPos Lib "User32" _
  (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
  ByVal X As Long, ByVal Y As Long, ByVal cx As Long, _
  ByVal cy As Long, ByVal uFlags As Long) As Long

Declare Function SetForegroundWindow Lib "User32" _
  (ByVal hwnd As Long) As Long

Declare Function GetForegroundWindow Lib "User32" () As Long


Function ShortCut(Target As String, _
  Optional Target_Type As Long) As Boolean

  Dim hwnd As Long
  Dim Pidl As Long
  Dim Bureau As String

  If Dir(Target & IIf(Target_Type = vbDirectory, "\", ""), _
    Target_Type) = "" Then Exit Function

  SHGetSpecialFolderLocation 0, 0, Pidl
  Bureau = Space(260)
  SHGetPathFromIDList Pidl, Bureau
  Bureau = Left(Bureau, InStr(1, Bureau, vbNullChar) - 1)

  hwnd = GetForegroundWindow
  SetWindowPos hwnd, -1, 0, 0, 0, 0, 3
  Shell "RunDLL32 AppWiz.Cpl,NewLinkHere " & Bureau & "\"
  SendKeys """" & Target & """~~", True
  SetForegroundWindow hwnd

  ShortCut = True

End Function

Sub Test()

  ' Creates a shortcut to the directory "C:\Temp"
  MsgBox IIf(ShortCut("C:\Temp", vbDirectory), _
    "Shortcut created", "Can't find the directory")

  ' Creates a shortcut to the file "C:\Temp\Zaza.xls"
  MsgBox IIf(ShortCut("C:\Temp\Zaza.xls"), _
    "Shortcut created", "Can't find the file")

End Sub


**********************************
EXCEL DEVELOPER'S TIP

by Jim Rech

How to duplicate your VBE setup.

So you've got your new PC and you've copied over your Excel.xlb and 
Personal.xls from the old machine.  Now you go into the VBE and... oh yeah, 
how do you copy over your VBE preferences, customizations and toolbars?  
Here's how:

- Run RedEdit.exe
- Navigate to the key HKEY_CURRENT_USER\Software\Microsoft\VBA\6.0\Common 
for Office 2000 or HKEY_CURRENT_USER\Software\Microsoft\VBA\Office for 
Office 97.
- From the file menu pick Export Registry File and select a file name.
- Copy the resulting REG file to the new machine.
- On the new machine you can run RegEdit and pick Import Registry File or 
from Windows Explorer right click on the file and select Merge.

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

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

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

CUMULATIVE INDEX (ISSSUES 11-15):

WORKSHEET FORMULAS:

Issue #11:
-case-sensitive MATCH function
-extract the phone number as text in form of 123-45678
-'bankers rounding' for a number to given number of significant digits.
 
Issue #12:
-reverse lookup formula with max value

Issue #13:
-using defined name formulas for creating a versatile consolidation 
workbook that works without any programming [DOWNLOAD EXAMPLE FILE]

Issue #14:

Issue #15:
-reverses the sequence of elements in a range
-returns TRUE if number is a prime number


VBA PROCEDURES:

Issue #11:
-selects the real last used cell in a worksheet
-function returns the dimension order of an array (up to 4D)
-brings data into a worksheet from an external source using ADO
-prints (in the Immediate window) the same list of files displayed
 by the Edit-Links menu command
-displays the chart wizard dialog box
-adjusts the row height of a merged cell with wrap text set
-returns the named ranges that include the active cell
-searches through all worksheets in a workbook

Issue #12:
-procedure for the filling of formulas across worksheets to obtain
 sheet-relative formulas
-converts normal formulas to those that show an empty cell
 if an error condition exists in the original formula

Issue #13:

Issue #14:
-series of boolean functions associated with filtered lists
-procedure delinks all of the charts in a workbook
-opens an application through the use of the Shell function and it 
 allows for the lag time involved with the opening process
-procedure removes all code and related structures from a workbook
-generalized procedures for converting data to a normalized form
-event procedures to place the contents of a cell into a cell comment
 when another entry is made

Issue #15:
-reads the names of all sheets in a closed workbook using ADO
-groups multiple worksheets and print a selection from the selected 
 sheets all on one page
-general function for evaluate and replace using comparisons
-assigns a procedure to the Click event of a command button added to 
 a form at run time
-adds an Add-In path dynamically while the add-in is loading
-finds all of the user-defined custom number formats in a workbook


TIPS AND TECHNIQUES:

Issue #11:
-list of web sites for products that will find/remove passwords
-workaround to formatting problems associated with merged cells
-quick way to freeze formulas to values on a worksheet
-using the UserInterfaceOnly argument of the Protect method
 
Issue #12:
-use defined names in a workbook that are defined in another workbook
-URL for David McRitchie's Excel web site

Issue #13:

Issue #14:
-URL for Rob Bovey's Excel web site

Issue #15:
-URL for Ole P.'s Excel web site
-URL for Aaron Blood's Excel web site