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