Issue No. 11 (September 15, 1999)

[Item URL]

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

COMMENTS

Welcome to the 11th 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.

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

This publication resumes its normal schedule after 6 weeks of inactivity.
I appreciate all of the positive comments I received during this time off.

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

TOP EXCEL WEB SITES

Here is a list of web sites for products that will find/remove passwords
from Excel workbooks/projects/worksheets. This list was compiled by Tom
Ogilvy.

http://www.accessdata.com
http://www.crak.com
http://www.lostpassword.com
http://www.elkraft.unit.no/~huse/xlpassword.htm
http://www.elkraft.ntnu.no/~huse/xlpassword.htm
http://www.elcomsoft.com/ae97pr.html
http://home.telia.no/exceltips/
http://www.zuarin.de/sec_eng.htm
http://webdon.com/mso/

services:
http://www.pwcrack.com/
http://www.passwordservice.com/crack.html


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

WORKSHEET FORMULA TIP

by Bob Umlas

This array formula is an example of a case-sensitive MATCH function.

=MATCH(TRUE,EXACT("A",MyRange),0)


by George Simms

This array formula will extract the phone number as text in the form of
123-45678 from examples as shown below.

234-5678PG
Result 234-5678

Array enter the formula and copy it down as far as needed for entries
in column A.

=MID(A1,MATCH(FALSE,ISERROR(1*MID(A1,ROW(INDIRECT("1:20")),1)),0),21-
SUM(1*ISERROR(1*MID(A1,ROW(INDIRECT("1:20")),1))))


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

POWER FORMULA TECHNIQUE

by Stephen Bullen

This formula perform 'bankers rounding' for a number (Num) to a given number
(Plc) of significant digits. 

=MROUND(Num,IF(VALUE(RIGHT(Num/10^(INT(LOG(ABS(Num)))-Plc+1),2))=0.5,2,1)*
SIGN(Num)*10^(INT(LOG(ABS(Num)))-Plc+1))

If you define 'Fact' as =10^(INT(LOG(ABS(Num)))-Plc+1), this reduces to:

=MROUND(Num,IF(VALUE(RIGHT(Num/Fact,2))=0.5,2,1)*SIGN(Num)*Fact)


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

VBA CODE EXAMPLES 

by Jim Rech (and others)

This procedure selects the last used cell in a worksheet.

Sub GotoLast()
    On Error Resume Next
    Application.ScreenUpdating = False
    Cells(Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row, _
    Cells.Find("*", Range("A1"), , , xlByColumns, xlPrevious).Column).Select
    If Err.Number <> 0 Then MsgBox "No data in sheet"
    Application.ScreenUpdating = True
End Sub


by Stephen Bullen

This function returns the dimension order of an array (up to 4D).

Public Function fnGetDimension(vaArray)

    Dim i As Integer, l As Long

    On Error Resume Next
    Err.Clear
    For i = 1 To 4
        l = UBound(vaArray, i)
        If Err.Number <> 0 Then Exit For
        fnGetDimension = i
    Next
    Err.Clear

End Function


by John Green

This procedure brings data into a worksheet from an external source
using ADO. Note that use of the Transpose function will introduce
array size limitations in versions of Excel previous to Excel 2000.

Sub GetDataWithADOIn97()
  Dim cnt As New ADODB.Connection
  Dim rst As New ADODB.Recordset
  Dim ws As Worksheet
  Dim recArray As Variant
  Dim fldCount As Integer
  Dim iCols As Integer
  Dim recCount As Long
  
  Set ws = ActiveSheet
  cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=C:\My Documents\SalesDb.mdb;"
  rst.Open "Select * From SalesData", cnt
  fldCount = rst.Fields.Count
  For iCols = 0 To fldCount - 1
    ws.Cells(1, iCols + 1).Value = rst.Fields(iCols).Name
  Next

  'Copy records to array
  recArray = rst.GetRows
  recCount = UBound(recArray, 2)
  'Transpose array into worksheet
  ws.Range(ws.Cells(2, 1), ws.Cells(recCount + 1, fldCount)).Value _
    = Application.Transpose(recArray)
End Sub


by John Walkenbach

This sub prints (in the Immediate window) the same list of files displayed
by the Edit-Links menu command.

Sub ShowLinks()
    On Error Resume Next
    For Each Lnk In ActiveWorkbook.LinkSources(xlExcelLinks)
        Debug.Print Lnk
    Next Lnk
    For Each Lnk In ActiveWorkbook.LinkSources(xlOLELinks)
        Debug.Print Lnk
    Next Lnk
End Sub


by Rob Bovey

This simple procedure displays the chart wizard dialog box.

Sub ShowChartWizard()
    CommandBars("Standard").FindControl(,436).Execute
End Sub


by Jim Rech

Excel does not support automatically adjusting the row height of a merged
cell with wrap text set.  This procedure serves as a workaround.

Sub AutoFitMergedCellRowHeight()
    Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
    Dim CurrCell As Range
    Dim ActiveCellWidth As Single, PossNewRowHeight As Single
    If ActiveCell.MergeCells Then
       With ActiveCell.MergeArea
            If .Rows.Count = 1 And .WrapText = True Then
                Application.ScreenUpdating = False
                CurrentRowHeight = .RowHeight
                ActiveCellWidth = ActiveCell.ColumnWidth
                For Each CurrCell In Selection
                    MergedCellRgWidth = CurrCell.ColumnWidth +
MergedCellRgWidth
                Next
                .MergeCells = False
                .Cells(1).ColumnWidth = MergedCellRgWidth
                .EntireRow.AutoFit
                PossNewRowHeight = .RowHeight
                .Cells(1).ColumnWidth = ActiveCellWidth
                .MergeCells = True
                .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
                 CurrentRowHeight, PossNewRowHeight)
            End If
        End With
    End If
End Sub


by Bernie Deitrick

This procedure returns the named ranges that include the active cell.

Sub DetermineRangeInclusion()
Dim myName As Name
Dim myAddress, myMessage As String
Dim InRange As Integer

myMessage = "Cell " & ActiveCell.Address & " is not in a Range"
InRange = 0

For Each myName In Application.Names
myAddress = myName.RefersTo
Set b = Intersect(ActiveCell, Range(myAddress))
If Not (b Is Nothing) Then
If InRange = 0 Then
InRange = 1
myMessage = "Cell " & b.Address & Chr(10) & Chr(13) & " is in " & myName.Name
Else: myMessage = myMessage & Chr(10) & Chr(13) _
& " and in " & myName.Name
End If
End If
Next myName

MsgBox myMessage
End Sub


by Jan Karel Pieterse

This procedure searches through all worksheets in a workbook.

Sub FindItAll()
    Dim oSheet As Object
    Dim Firstcell As Range
    Dim NextCell As Range
    Dim WhatToFind As Variant
    WhatToFind = Application.InputBox("What are you looking for ?", "Search", , 100, 100, , , 2)
        If WhatToFind <> "" And Not WhatToFind = False Then
            For Each oSheet In ActiveWorkbook.Worksheets
            oSheet.Activate
            oSheet.[a1].Activate
            Set Firstcell = Cells.Find(What:=WhatToFind, LookIn:=xlValues, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                If Not Firstcell Is Nothing Then
                Firstcell.Activate
                MsgBox ("Found " & Chr(34) & WhatToFind & Chr(34) & " in " & oSheet.Name & "!" & Firstcell.Address)
                On Error Resume Next
                    While (Not NextCell Is Nothing) And (Not NextCell.Address = Firstcell.Address)
                    Set NextCell = Cells.FindNext(After:=ActiveCell)
                        If Not NextCell.Address = Firstcell.Address Then
                        NextCell.Activate
                        MsgBox ("Found " & Chr(34) & WhatToFind & Chr(34) & " in " & oSheet.Name & "!" & NextCell.Address)
                        End If
                    Wend
                End If
            Set NextCell = Nothing
            Set Firstcell = Nothing
            Next oSheet
        End If
End Sub


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

EXCEL PRODUCTIVITY TIPS

by Rob Bovey

When the merge cells feature is used on a worksheet, it is difficult to
make additional formatting changes to columns/rows that contain the merged
cell(s).

The best workaround in this case is just not to use the merge cells feature. 
The old center across selection, which does the same thing for most purposes 
and causes no problems, is still available. It's just hidden under the 
Format/Cells/Alignment menu at the bottom of the Horizontal dropdown.


by David Hager

There is a quicker way to freeze formulas to values on a worksheet than
using Edit Copy, then Edit Paste Special and choosing the Values option.
After making a selection, right-click its edge and drag it away slightly.
Then, place it back in its original position. When you do that, a popup
menu appears. Select the Copy Here as Values option and you are finished.

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

DO YOU KNOW?...

that if you apply the Protect method with the UserInterfaceOnly argument 
set to True to a worksheet and then save the workbook, the entire worksheet 
(not just the interface) will be fully protected when you reopen the workbook. 
To unprotect the worksheet but re-enable user interface protection after 
the workbook is opened, you must again apply the Protect method with 
UserInterfaceOnly set to True.

discoverd by Vasant Nanavati in online help

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

Issue No.11 OF EEE (PUBLISHED 15Sep1999)
Next issue scheduled for 01Oct1999.
BY David Hager
dchager@compuserve.com

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