Issue No. 20 (July 8, 2001)

[Item URL]

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

COMMENTS

Welcome to the 20th issue of the Excel Experts E-letter (or EEE), by 
David Hager. EEE used to be a monthly publication. It's been a long
time since the last issue, and I cannot say when the next issue
will be. 

Feel free to distribute copies of EEE to your friends and colleagues and 
to contribute your Excel gems to EEE so that others can benefit from your 
work. 

All issues are available for download from the EEE web page located on 
John Walkenbach's web site. 

Due to problems associated with distribution lists, I cannot mail EEE 
directly to individuals anymore. Look for the latest issue at:

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

 
**********************************
Top Excel Sites

See:

http://home.pacbell.net/beban

for a great collection of array UDFs.

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

POWER FORMULA TECHNIQUES

by David Hager

---How can I find the count of unique items in a filtered column?---

Define a column range in your table (excluding header) as Rge.

Define unRge as:
=IF(SUBTOTAL(3,OFFSET(Rge,ROW(Rge)-MIN(ROW(Rge)),,1)),Rge,"")

Then, the array formula to return the # of unique occurrences in a filtered 
column is:

=SUM(N(IF(ISNA(MATCH("",unRge,0)),MATCH(Rge,Rge,0),IF(MATCH(unRge,unRge,0)
=MATCH("",unRge,0),0,MATCH(unRge,unRge,0)))=ROW(Rge)-MIN(ROW(Rge))+1))


by Tom Ogilvy

---How can I set validation so no spaces are allowed?---

Select A1:C20 with A1 as the active cell in the selection.

Pick Data=>Validation from the menu and select the custom option.

Use the following formula:

=LEN(A1)=LEN(SUBSTITUTE(A1," ",""))

Since you are using relative cell references, the validation formula will
adjust to address each of the cells in the selection.


by John Walkenbach and John Green

---How can I locate cells containing formulas with literal values?---

Use the following UDF as your conditional formatting formula.
 
Function CellUsesLiteralValue(Cell As Range) As Boolean
    If Not Cell.HasFormula Then
        CellUsesLiteralValue = False
    Else
        CellUsesLiteralValue = Cell.Formula Like "*[=^/*+-/()><, ]#*"
    End If
End Function

It accepts a single cell as an argument. It returns True if the cell's
formula contains an operator followed by a numerical digit. In other words, 
it identifies cells that have a formula which contains a literal numeric 
value.

You can test each cell in the range, and highlight it if the function
returns True.


by George Simms

---If the NETWORKDAYS function (found in the Analysis Toolpak) cannot be used,
is there a formula that will perform the same function?---

If the Start date is in A1 and the End date is in B1, then use:

=(INT(B1/7)-INT(A1/7))*5+MAX(0,MOD(B1,7)-1)-MAX(0,MOD(A1,7)-2)


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

VBA CODE EXAMPLES 

by Bill Manville

---The objective is to prevent people cutting/copying and pasting when your 
workbook is open.---

Run DisableCutAndPaste from a suitable event procedure 
(e.g. Workbook_Open or Worksheet_Activate) and EnableCutAndPaste 
from another (e.g. Workbook_Close or Worksheet_Deactivate).  

Sub DisableCutAndPaste()
  EnableControl 21, False   ' cut
  EnableControl 19, False   ' copy
  EnableControl 22, False   ' paste
  EnableControl 755, False  ' pastespecial
  Application.OnKey "^c", ""
  Application.OnKey "^v", ""
  Application.OnKey "+{DEL}", ""
  Application.OnKey "+{INSERT}", ""
  Application.CellDragAndDrop = False
End Sub

Sub EnableCutAndPaste()
  EnableControl 21, True   ' cut
  EnableControl 19, True   ' copy
  EnableControl 22, True   ' paste
  EnableControl 755, True  ' pastespecial
  Application.OnKey "^c"
  Application.OnKey "^v"
  Application.OnKey "+{DEL}"
  Application.OnKey "+{INSERT}"
  Application.CellDragAndDrop = True
End Sub

Sub EnableControl(Id As Integer, Enabled As Boolean)
  Dim CB As CommandBar
  Dim C As CommandBarControl
  For Each CB In Application.CommandBars
    Set C = CB.FindControl(Id:=Id, recursive:=True)
    If Not C Is Nothing Then C.Enabled = Enabled
  Next
End Sub


by Chip Pearson

---Is is possible to disable certain menu items on both the toolbar and the 
right-click pop-up that wil prevent the user from either deleteing/renaming, 
a sheet without protecting the entire workbook structure?---

You can disable them with:

Dim Ctrl As Office.CommandBarControl
For Each Ctrl In Application.CommandBars.FindControls(ID:=847)
    Ctrl.Enabled = False
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=889)
    Ctrl.Enabled = False
Next Ctrl


by Chip Pearson

---How can I search through all the cell formulas on a worksheet and find out 
the cells that reference a specific named range?---

Use the following procedure:

Dim Rng As Range
Dim NameRange As Range
Set NameRange = ActiveWorkbook.Names("TheName").RefersToRange

On Error Resume Next
For Each Rng In ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
    Err.Clear
    If Not Application.Intersect(Rng.DirectPrecedents, NameRange) Is Nothing
Then
        If Err.Number = 0 Then
            Debug.Print "Cell: " & Rng.Address & " refers to " &
NameRange.Address
        End If
    End If
Next Rng


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

POWER PROGRAMMING TECHNIQUE

by Jim Rech

---Can I change the Excel logo to something else?---

This code shows you how to change the Excel icon:

Declare Function GetActiveWindow32 Lib "USER32" Alias _
"GetActiveWindow" () As Integer

Declare Function SendMessage32 Lib "USER32" Alias _
"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
   ByVal wParam As Long, ByVal lParam As Long) As Long

Declare Function ExtractIcon32 Lib "SHELL32.DLL" Alias _
"ExtractIconA" (ByVal hInst As Long, _
   ByVal lpszExeFileName As String, _
    ByVal nIconIndex As Long) As Long

Sub ChangeXLIcon()
    Dim h32NewIcon As Long
    Dim h32WndXLMAIN As Long
    h32NewIcon = ExtractIcon32(0, "Notepad.exe", 0)
    h32WndXLMAIN = GetActiveWindow32()
    SendMessage32 h32WndXLMAIN, &H80, 1, h32NewIcon 'Icon big
    SendMessage32 h32WndXLMAIN, &H80, 0, h32NewIcon 'Icon small
End Sub


by Leo Heuser

---I would like to create a Excel template which when you open a document
from it, it assigns a unique sequential number to the new document.
Is there a way of doing this?--- 

Below find two routines to do, what you want. They are both
inserted in "ThisWorkbook" () for the template and
are fired, when a new invoice is created.

The first one saves the current invoice number to the registry,
and can be used, if you are the sole user of the system. The
second solution saves the number in an INI-file, which you can
place, where you please. This solution is useful, if more persons
are using the invoice system.


Private Sub Workbook_Open()
'leo.heuser@get2net.dk June/October 2000
'From the template, in the VBA editor, set a reference to
'Microsoft Visual Basic for Applications Extensibility 5.3
'in the menu Tools

Dim WorksheetName As String
Dim WorksheetCell As String
Dim SettingName As String
Dim lLine As Long
Dim InvoiceNumber As Variant
Dim InvoiceNumberCell As Object
Dim TemplateName As String

    TemplateName = "John.xlt"
    WorksheetName = "Invoice"
    WorksheetCell = "F7"
    SettingName = "John"


    Set InvoiceNumberCell = Worksheets(WorksheetName).Range(WorksheetCell)
    If UCase(ActiveWorkbook.Name) = UCase(TemplateName) Then GoTo Finito
    InvoiceNumber = GetSetting(SettingName, WorksheetName, "InvoiceNumber")
    If InvoiceNumber = "" Then
        InvoiceNumber = 1
    Else
        InvoiceNumber = InvoiceNumber + 1
    End If
    SaveSetting SettingName, WorksheetName, "InvoiceNumber", InvoiceNumber
    InvoiceNumberCell.Value = InvoiceNumber
    With
ActiveWorkbook.VBProject.VBComponents(ActiveWorkbook.CodeName).CodeModule
        lLine = .ProcBodyLine("Workbook_Open", vbext_pk_Proc)
        .InsertLines lLine + 1, "Exit Sub"
    End With
Finito:
Set InvoiceNumberCell = Nothing
End Sub

________________________________________________________

Private Declare Function GetPrivateProfileString Lib "kernel32" Alias
"GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal
lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As
String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias
"WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal
lpKeyName As String, ByVal lpString As Any, ByVal lpFileName As String) As
Long

Private Sub Workbook_Open()
'leo.heuser@get2net.dk June 2000
'From the template, in the VBA editor, set a reference to
'Microsoft Visual Basic for Applications Extensibility 5.3
'in the menu Tools

Dim WorksheetName As String
Dim WorksheetCell As String
Dim Section As String
Dim kKey As String
Dim lLine As Long
Dim InvoiceNumber As Long
Dim InvoiceNumberCell As Object
Dim TemplateName As String
Dim IniFileName As String
Dim Dummy As Variant

    TemplateName = "John2.xlt"
    WorksheetName = "Invoice"
    WorksheetCell = "F7"
    Section = "Invoice"
    kKey = "Number"
    IniFileName = "C:\Windows\Temp\InvoiceNumber.txt"

    Set InvoiceNumberCell = Worksheets(WorksheetName).Range(WorksheetCell)
    If UCase(ActiveWorkbook.Name) = UCase(TemplateName) Then GoTo Finito
    Dummy = GetString(Section, kKey, IniFileName)
    If Left(Dummy, 1) = Chr$(0) Then
        InvoiceNumber = 1
    Else
        InvoiceNumber = CLng(Dummy) + 1
    End If
    WritePrivateProfileString Section, kKey, CStr(InvoiceNumber),
IniFileName
    InvoiceNumberCell.Value = InvoiceNumber
    With
ActiveWorkbook.VBProject.VBComponents(ActiveWorkbook.CodeName).CodeModule
        lLine = .ProcBodyLine("Workbook_Open", vbext_pk_Proc)
        .InsertLines lLine + 1, "Exit Sub"
    End With
Finito:
Set InvoiceNumberCell = Nothing
End Sub

Function GetString(Section As String, Key As String, File As String) As
String
    Dim KeyValue As String
    Dim Characters As Long
    KeyValue = String(255, 0)
    Characters = GetPrivateProfileString(Section, Key, "", KeyValue, 255,
File)
    If Characters > 1 Then
        KeyValue = Left(KeyValue, Characters)
    End If
    GetString = KeyValue
End Function


by Jim Rech

---Is there a way to delete all name ranges in a selection at one time?---

Be careful to not break references to other formulas when using this 
procedure.

Sub Dename()
    Dim Cell As Range
    ActiveSheet.TransitionFormEntry = True
    For Each Cell In Selection.SpecialCells(xlFormulas)
        Cell.Formula = Cell.Formula
    Next
    ActiveSheet.TransitionFormEntry = False
End Sub


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

DEVELOPER TIPS


by Chip Pearson

---Notes on an interesting and useful debugging technique.---

Suppose you are developing some application, and you have some global
variable such as:

Public  NumberOfUnits As Long

In your app, the only reasonable value for this is, say, between 1 and 100.
For debugging purposes, you can "trap" your errors, when you assign an
invalid value to this, as follows.

In your standard code module (NOTE: This does NOT have to be in a class
module!) do the following:

Dim p_NumberOfUnits As Long
Property Get NumberOfUnits() As Long
    NumberOfUnits = p_NumberOfUnits
End Property
Property Let NumberOfUnits(Value As Long)
    If (Value >=1 ) And (Value <=100) Then
        p_NumberOfUnits = Value
    Else
        Err.Raise 5
    End If
End Property

Then, in the rest of your code, you'd access the variable in the normal way:

Sub AAA()
NumberOfUnits = 10
NumberOfUnits = 123
Msgbox "Units: " & NumberOfUnits
End Sub

These standard access methods will indeed take you through the get/let/set
property procedures. And yes, standard code modules (BAS files) do support
Property Get/Let/Set procedures.  You're code will blow up on the statement

NumberOfUnits = 123

(You must raise an error.  The specific error is, of course, you choice.)

Then, just use the View Call Stack to see where you called this from.  Of
course, this adds some overhead, so in the production version of the code,
you'd remove the Property Get/Let pair, and rename

Dim p_NumberOfUnits As Long
to
Dim NumberOfUnits As Long

Or, of course, you could do everything with conditional compilation.

In the end, the really interesting thing is that you can use property
get/let/set procedures in a standard code module, not just in a class
module.


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

Issue No.20 OF EEE (PUBLISHED 09Jul2001)
Next issue scheduled for [UNKNOWN]
BY David Hager
dchager@compuserve.com

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