********************************** COMMENTS Welcome to the 7th 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. ********************************* EXCEL 2000 DESIGN IRREGULARITIES Considering the large amount of private and public beta testing of Excel 2000 and the relatively small number of changes that were made, you might have thought that this version would be basically error-free. Well, at least Microsoft is doing a good job of reporting problems. Here are some of the problems associated with copy/pasting. When you copy and paste cells, copied formulas are pasted as static values; the formulas are not copied. This problem occurs when you copy cells that are not one contiguous range of cells. For example, you select the range A1:A5, C1:C5, copy the cells, and paste them all as one block in cell D1. This problem also existed in Excel 97. See: http://support.microsoft.com/support/kb/articles/q210/7/25.asp Since the new Office Clipboard stores only values, you cannot use it to copy/paste formulas. However, it may appear that you can, but the formulas are actually coming from the Windows Clipboard. See: http://support.microsoft.com/support/kb/articles/q209/2/84.asp There are problems with the cut/pasting of formulas containing 3D references. See: http://support.microsoft.com/support/kb/articles/q215/2/17.asp ********************************** POWER FORMULA TECHNIQUE Created by David Hager The goal is to create a way to tranform a string into a sorted string. This can be easily done with an user-defined function, as shown below. Option Base 1 Function SortStr(uSortStr As String) As String Dim sArr() Dim newStr As String Dim store As String Dim strlen As Integer strlen = Len(uSortStr) ReDim sArr(strlen) For s = 1 To strlen sArr(s) = Mid(uSortStr, s, 1) Next For i = 1 To UBound(sArr) - 1 For j = i + 1 To UBound(sArr) If sArr(i) > sArr(j) Then store = sArr(i) sArr(i) = sArr(j) sArr(j) = store End If Next Next newStr = "" For r = 1 To strlen newStr = newStr & sArr(r) Next SortStr = newStr End Function The SortStr function returns a string sorted in ascending order, but it could be easily modified with a second argument to choose ascending or descending order. Although this can be done with an UDF, the challenge is there to accomplish the same goal by just using worksheet formulas. Part of the solution shown below is somewhat kludgy, due to the lack of an Excel function that concatenates elements of an array into a string (perhaps this can be done with the CALL function, though). The following defined name formula transforms a string into a sorted array of characters that comprise the string (the active cell must be B1 during the creation of this formula). Define sArr as: =CHAR(SMALL(CODE(MID(A1,ROW(INDIRECT("1:"&LEN(A1))),1)), ROW(INDIRECT("1:"&LEN(!A1))))) The MID function creates the array of characters. The CODE function returns the ASCII code number for each character in the array. The SMALL function sorts the array of code numbers in ascending order. Finally, the CHAR function returns the ASCII character for each code number in the array. In order to convert the array into a string, the following defined name formula was created for each character in the string. Define zz1 as: =IF(ISERROR(INDEX(sArr,1)),"",INDEX(sArr,1)) where the number argument in the INDEX function indicates the character position in the array. These formulas are concatenated by the following defined name formula. Define SortString as: =zz1&zz2&zz3&zz4&zz5&...etc Of course, this will only work for strings that <= the # of formulas that have been concatenated. Now, if you type =SortStr in a cell to the right of a cell containing a string, the sorted string will be returned. I don't know if there is a burning need for the preceding techniques, but it has been an interesting exercise. ********************************** VBA CODE EXAMPLES Created by Rob Bovey Here is a data encryption/decryption method for strings. Option Explicit Sub Test() Dim szTest As String szTest = "My dog has fleas." ''' Encrypt the string EncryptDecrypt szTest MsgBox szTest ''' Decrypt the string EncryptDecrypt szTest MsgBox szTest End Sub ''' This procedure is a quick and dirty encryption/decryption ''' device. It will process as much text as you can load into ''' a string variable and it is *very* fast. I've encrypted ''' entire documents worth of text with it. ''' ''' You can store the encrypted text in a text file or the ''' registry for later retrieval and decryption. ''' ''' szData The string you want to encrypt/decrypt. ''' Pass the string through once to encrypt it. ''' Pass it through a second time to decrypt it. ''' Sub EncryptDecrypt(ByRef szData As String) Const lKEY_VALUE As Long = 215 Dim bytData() As Byte Dim lCount As Long bytData = szData For lCount = LBound(bytData) To UBound(bytData) bytData(lCount) = bytData(lCount) Xor lKEY_VALUE Next lCount szData = bytData End Sub Sub ViewDecrEncr() EncryptDecrypt "This is a test." MsgBox szData End Sub ********************************** POWER PROGRAMMING TECHNIQUE By Leo Heuser This procedure provides a workaround for the glaring lack of accessibility in VBA for manipulating custom number formats. To do this, it hacks into the Number Format dialog box with SendKeys. It loops through each item, including those custom number formats that have been orphaned from the worksheet. The dialog box flickers upon each opening, but it works! If anyone comes up with a way to eliminate the flicker, let me know. Sub DeleteUnusedCustomNumberFormats() Dim Buffer As Object Dim Sh As Object Dim SaveFormat As Variant Dim fFormat As Variant Dim nFormat() As Variant Dim xFormat As Long Dim Counter As Long Dim Counter1 As Long Dim Counter2 As Long Dim StartRow As Long Dim EndRow As Long Dim Dummy As Variant Dim pPresent As Boolean Dim NumberOfFormats As Long Dim Answer Dim c As Object Dim DataStart As Long Dim DataEnd As Long Dim AnswerText As String NumberOfFormats = 1000 ReDim nFormat(0 To NumberOfFormats) AnswerText = "Do you want to delete unused custom formats from the workbook?" AnswerText = AnswerText & Chr(10) & "To get a list of used and unused formats only, choose No." Answer = MsgBox(AnswerText, 259) If Answer = vbCancel Then GoTo Finito On Error GoTo Finito Worksheets.Add.Move after:=Worksheets(Worksheets.Count) Worksheets(Worksheets.Count).Name = "CustomFormats" Worksheets("CustomFormats").Activate Set Buffer = Range("A2") Buffer.Select nFormat(0) = Buffer.NumberFormatLocal Counter = 1 Do SaveFormat = Buffer.NumberFormatLocal Dummy = Buffer.NumberFormatLocal DoEvents SendKeys "{tab 3}{down}{enter}" Application.Dialogs(xlDialogFormatNumber).Show Dummy nFormat(Counter) = Buffer.NumberFormatLocal Counter = Counter + 1 Loop Until nFormat(Counter - 1) = SaveFormat ReDim Preserve nFormat(0 To Counter - 2) Range("A1").Value = "Custom formats" Range("B1").Value = "Formats used in workbook" Range("C1").Value = "Formats not used" Range("A1:C1").Font.Bold = True StartRow = 3 EndRow = 16384 For Counter = 0 To UBound(nFormat) Cells(StartRow, 1).Offset(Counter, 0).NumberFormatLocal = nFormat(Counter) Cells(StartRow, 1).Offset(Counter, 0).Value = nFormat(Counter) Next Counter Counter = 0 For Each Sh In ActiveWorkbook.Worksheets If Sh.Name = "CustomFormats" Then Exit For For Each c In Sh.UsedRange.Cells fFormat = c.NumberFormatLocal If Application.WorksheetFunction.CountIf(Range(Cells(StartRow, 2), Cells(EndRow, 2)), fFormat) = 0 Then Cells(StartRow, 2).Offset(Counter, 0).NumberFormatLocal = fFormat Cells(StartRow, 2).Offset(Counter, 0).Value = fFormat Counter = Counter + 1 End If Next c Next Sh xFormat = Range(Cells(StartRow, 2), Cells(EndRow, 2)).Find("").Row - 2 Counter2 = 0 For Counter = 0 To UBound(nFormat) pPresent = False For Counter1 = 1 To xFormat If nFormat(Counter) = Cells(StartRow, 2).Offset(Counter1, 0).NumberFormatLocal Then pPresent = True End If Next Counter1 If pPresent = False Then Cells(StartRow, 3).Offset(Counter2, 0).NumberFormatLocal = nFormat(Counter) Cells(StartRow, 3).Offset(Counter2, 0).Value = nFormat(Counter) Counter2 = Counter2 + 1 End If Next Counter With ActiveSheet.Columns("A:C") .AutoFit .HorizontalAlignment = xlLeft End With If Answer = vbYes Then DataStart = Range(Cells(1, 3), Cells(EndRow, 3)).Find("").Row + 1 DataEnd = Cells(DataStart, 3).Resize(EndRow, 1).Find("").Row - 1 On Error Resume Next For Each c In Range(Cells(DataStart, 3), Cells(DataEnd, 3)).Cells ActiveWorkbook.DeleteNumberFormat (c.NumberFormat) Next c End If Finito: Set c = Nothing Set Sh = Nothing Set Buffer = Nothing End Sub ********************************** EXCEL 2000 PROGRAMMING TIP Created by David Hager The Spreadsheet Component has an extensive object model similar to Excel itself, but one of the features it does not have is the ability to use array formulas. Presented below is a workaround to that deficiency that allows the entering of an array formula in a Spreadsheet cell and the calculation of that formula to afford the result in the cell. However, the calculation is actually performed on a worksheet named "slink" in the workbook containing this application. So, for this to work you need an UserForm with a CommandButton (named CommandButton1) and a visible Spreadsheet Component (named Spreadsheet1) and the worksheet named "slink". Place this code in the UserForm module. When you want to calculate an array formula in the Spreadsheet Component, you click the button and type your formula in a cell. You can change what is initially in the Spreadsheet Component at design time, and that data is updated on the slink worksheet at run time by the Initialize event. Subsequent changes are handled by the Calculate event of the Spreadsheet Component. Public EAF As Boolean Private Sub CommandButton1_Click() EAF = True End Sub Private Sub Spreadsheet1_Calculate(ByVal EventInfo As OWC.SpreadsheetEventInfo) Dim pRange As Range Dim aCell As Range If Not EAF Then Exit Sub On Error Resume Next Application.EnableEvents = False If Spreadsheet1.ActiveCell.Formula = "" Then EAF = False Exit Sub End If Set pRange = ThisWorkbook.Worksheets("sLink").Range(Spreadsheet1. _ ActiveSheet.UsedRange.Address) Set aCell = ThisWorkbook.Worksheets("sLink").Range(Spreadsheet1. _ ActiveCell.Address) Spreadsheet1.ActiveSheet.UsedRange.Copy pRange.PasteSpecial Spreadsheet1.ActiveCell.Formula = Application.Evaluate(aCell.Formula) EAF = False End Sub Private Sub UserForm_Initialize() Dim pRange As Range Dim aCell As Range Application.EnableEvents = False Set pRange = ThisWorkbook.Worksheets("sLink").Range(Spreadsheet1. _ ActiveSheet.UsedRange.Address) Spreadsheet1.ActiveSheet.UsedRange.Copy pRange.PasteSpecial End Sub ********************************** DID YOU KNOW?... that the Spreadsheet Component calculates dates differently than Excel. In fact, it works much better! See: http://support.microsoft.com/support/kb/articles/q210/7/82.asp for details and http://support.microsoft.com/support/kb/articles/Q216/5/78.asp for information on calculation differences between Excel 2000 and the Spreadsheet Component. ********************************** Issue No.7 OF EEE (PUBLISHED 15Jun1999) Next issue scheduled for 01Jul1999. BY David Hager dchager@compuserve.com **********************************