Issue No. 06 (June 1, 1999)
**********************************
COMMENTS
Welcome to the 6th 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.
My pronouncement in EEE #5 that EEE would no longer be directly mailed was
premature. I have corrected some problems I was having with my e-mail
software, so I will try to continue direct mailing for now.
I have received some corrections/improvements on a few of the items that
have been published in EEE. I plan to start a section for this in the next
issue. Another section that will debut to coincide with the release of Office
2000 in EEE #7 is the reporting of design irregularities associated with
Excel 2000, and workarounds for these if they exist.
**********************************
TOP EXCEL WEB SITES - WORKSHEET FORMULA TIP
Created by David Hager
If you want to find information posted in Internet newsgroups by a particular
person, you can use the following technique. First, make a 4 column list as
shown below (on Sheet1).
A B C D
Mike Jomes mjomes@abc.com Mike Jomes mjomes@abc.com
Kim Jimes kjimes@xyz.com Kim Jimes kjimes@def.com
etc.
where column D concatenates the information in columns A-C. Then, use that
column as the list for Data Validation in a cell. Give the list a defined
name such as addList if it is on another worksheet than the HYPERLINK formula
shown below, as it is in this example). To make the list dynamic, use:
=OFFSET(Sheet1!$D$1,,,COUNTA(Sheet1!$D:$D),)
Create the Data Validation for cell D1 on Sheet2 (by using =addList as the
lookup list). Then, type this formula in A1 on Sheet2 and fill to C1.
=OFFSET(Sheet1!A$1,MATCH($D$1,addList,0)-1,,,)
Finally, type this formula in A2 on Sheet2:
=HYPERLINK("http://www.deja.com/profile.xp?author=%22"&$A$1&"%20"&$B$1&"%22
%20%3c"&$C$1&"%3e&ST=PS")
This creates a hyperlink that will return the newsgroup postings of the
person you have selected from the list. I use this technique to obtain
information posted by specific individuals in the Excel newsgroups.
**********************************
VBA CODE EXAMPLES
Created by Rob Bovey
Creates a list of all number formats in use in the active workbook.
Sub ListNumberFormats()
Dim lCount As Long
Dim lRow As Long
Dim rngCell As Range
Dim szSheet As String
Dim szFormat As String
Dim szFormatArray() As String
Dim wksSheet As Worksheet
Dim wkbTargetBook As Workbook
Dim wkbReportBook As Workbook
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
ReDim szFormatArray(0 To 0)
szFormatArray(0) = "NumberFormats in Use:"
Set wkbTargetBook = ActiveWorkbook
For Each wksSheet In wkbTargetBook.Worksheets
szSheet = wksSheet.Name
lRow = 1
For Each rngCell In wksSheet.UsedRange
If rngCell.Row <> lRow Then lRow = rngCell.Row
Application.StatusBar = "Determining NumberFormats in use. " & _
"Checking worksheet " & szSheet & " row " & CStr(lRow)
szFormat = rngCell.NumberFormat
''' If the current NumberFormat isn't already part of the array, add it.
If IsError(Application.Match(szFormat, szFormatArray, 0)) Then
lCount = lCount + 1
ReDim Preserve szFormatArray(0 To lCount)
szFormatArray(lCount) = szFormat
End If
Next rngCell
Next wksSheet
''' Add a new workbook and dump the array into it.
Set wkbReportBook = Workbooks.Add(xlWBATWorksheet)
Set rngCell = wkbReportBook.Worksheets(1).Range("a1")
For lCount = LBound(szFormatArray) To UBound(szFormatArray)
rngCell.Offset(lCount, 0).Value = szFormatArray(lCount)
Next lCount
rngCell.EntireColumn.AutoFit
Application.ScreenUpdating = True
Application.StatusBar = False
Application.Calculation = xlCalculationAutomatic
End Sub
[In the next issue, a method for deleting custom number formats that are not
currently in use (created by Leo Hauser) will be presented.]
Created by Chip Pearson
Cleans up data by removing tabs and carriage returns in worksheet cells.
Sub CleanUp()
Dim TheCell As Range
For Each TheCell In ActiveSheet.UsedRange
With TheCell
If .HasFormula = False Then
.Value = Application.WorksheetFunction.Clean(.Value)
End If
End With
Next TheCell
End Sub
**********************************
POWER PROGRAMMING TECHNIQUE
By Victor Eldridge
The following code is written for Excel 97. It displays pop-up
messages when the mouse cursor is rested over embedded charts.
Unlike Excel 's built-in chart tips, XTips allows you to specify
individual tips for every data point in every series.
It also allows you to format the text, and the textbox.
Unlike other techniques (that utilise a chart's MouseMove event) ,
XTips avoids screen flicker when working with more than one chart.
To use it, copy the code below to a standard module and run the
XTipsOn subroutine to turn them on.
XTipsOff subroutine to turn them off.
It assumes that the Source Data for your charts is layed out
vertically in columns , and further assumes that the column to
the right of the source data, contains your personalized chart tips.
For example :
Series1 Series1 Series2 Series2 etc...
Data Tips Data Tips
20 What 88 More
25 ever 74 of
33 you 63 your
29 like 93 own
30 goes 72 chart
27 here 85 tips
You will also need to place a TextBox (from the Drawing ToolBar)
on each worksheet that contains a chart. Format it as you wish.
NOTE : NOT an ActiveX textbox.
Known problems:
* The Worksheet window must be maximised.
* Excel's Zoom factor must be set to 100% .
* Windows' Font size must be set to small.
* Overlapping plot areas may have unpredictable results.
* The Cursor & Status Bar do not show default Excel behaviour.
* It does not support some chart types.
* It does not support chart sheets.
* Split windows & frozen panes will cause problems.
* Compared to Excel's built-in chart tips, XTips is slow.
That 's a pretty long list but everything else seems to work OK.
Remember, XTips is only an alternative.
'API function to find out the position of the cursor.
Declare Function GetCursorPos Lib "user32" (lppoint As CursorCoords) As Long
Type CursorCoords
X As Long
Y As Long
End Type
Dim pos As CursorCoords
'API function to find out height of the Windows caption bar.
Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long
Public Const SM_CYCAPTION = 4
Dim PreviousX As Long
Dim PreviousY As Long
Dim CurrentX As Long
Dim CurrentY As Long
Dim GetIt As Variant
Dim Yoffset As Single
Dim Xoffset As Single
Dim NextTime As Date
Dim TLTop As Single
Dim TLLeft As Single
Dim CurrentChart As Chart
Dim chrt As Object
Dim bar As Object
Dim Fix2D As Long
Dim I As Integer
Dim Counter As Integer
Dim X As Long
Dim Y As Long
Dim ElementID As Long
Dim SeriesIndex As Long
Dim PointIndex As Long
Dim F As String
Dim StartOfRange As Integer
Dim EndOfRange As Integer
Dim EndOfWorkbook As Integer
Dim SeriesRange As String
Dim SeriesWorkbook As String
Dim SeriesWorksheet As String
Sub XTipsOn()
NextTime = Now + TimeValue("00:00:01")
With Application
.Cursor = xlNorthwestArrow
.StatusBar = "Ready"
.ShowChartTipNames = False
.ShowChartTipValues = False
.OnTime NextTime, "XTipsOn" 'Starts a recursive loop.
End With
Call GetXoffset
Call GetYoffset
'Get the current position of the cursor.
PreviousX = pos.X - Xoffset - (Application.Left * 1.333) - 3
PreviousY = pos.Y - Yoffset - (Application.Top * 1.333) - 4
GetIt = GetCursorPos(pos)
CurrentX = pos.X - Xoffset - (Application.Left * 1.333) - 3
CurrentY = pos.Y - Yoffset - (Application.Top * 1.333) - 4
On Error Resume Next 'happens when no textbox is on the worksheet.
If CurrentX <> PreviousX Or CurrentY <> PreviousY _
Then 'The mouse is moving.
ActiveSheet.TextBoxes(1).Visible = msoFalse
Else: 'The mouse is at rest.
If ActiveSheet.TextBoxes(1).Visible = msoFalse Then DisplayTip
End If
On Error GoTo 0
End Sub
Sub DisplayTip()
'Gets the Top & Left values of the cell at the top,left of the screen.
TLTop = Cells(ActiveWindow.ScrollRow, ActiveWindow.ScrollColumn).Top
TLLeft = Cells(ActiveWindow.ScrollRow, ActiveWindow.ScrollColumn).Left
'Works out which chart is underneath the cursor.
For Each chrt In ActiveSheet.ChartObjects
If (chrt.Left - TLLeft) * 1.333 < CurrentX And _
(chrt.Left + chrt.Width - TLLeft) * 1.333 > CurrentX And _
(chrt.Top - TLTop) * 1.333 < CurrentY And _
(chrt.Top + chrt.Height - TLTop) * 1.333 > CurrentY _
Then
Set CurrentChart = ActiveSheet.ChartObjects(chrt.Index).Chart
Exit For
End If
If chrt.Index = ActiveSheet.ChartObjects.Count _
Then ' There is no chart underneath the cursor.
Exit Sub
End If
Next
'Makes an adjustment if the chart does not have a 3D effect.
On Error GoTo ChartIsNot3D
Fix2D = CurrentChart.Floor.Interior.ColorIndex
On Error GoTo 0
'X & Y will be passed to the GetChartElement method.
X = CurrentX - (CurrentChart.Parent.Left - TLLeft) * 1.333
Y = CurrentY - (CurrentChart.Parent.Top - TLTop) * 1.333
CurrentChart.GetChartElement X, Y, ElementID, SeriesIndex, PointIndex
If ElementID <> 3 Then Exit Sub
'Finds the range that contains the Series' Source Data.
F = CurrentChart.SeriesCollection(SeriesIndex).Formula
If Mid(F, 1, 10) <> "," _
Then 'The chart has a range specified for X-axis labels.
F = Left(F, 9) & Mid(F, InStr(10, F, ","))
End If
StartOfRange = InStr(1, F, "!")
EndOfRange = InStr(StartOfRange + 1, F, ",")
SeriesRange = Mid(F, StartOfRange + 1, _
EndOfRange - StartOfRange - 1)
'Finds the Workbook & Worksheet containing the Series' Source Data.
EndOfWorkbook = InStr(F, "]")
If EndOfWorkbook > 0 _
Then 'The Source Data is in a separate Workbook.
SeriesWorkbook = Mid(F, 13, EndOfWorkbook - 13)
SeriesWorksheet = Mid(F, EndOfWorkbook + 1, _
(StartOfRange - EndOfWorkbook - 2))
Else: 'The Source Data is in the Active Workbook.
SeriesWorkbook = ActiveWorkbook.Name
SeriesWorksheet = Mid(F, 11, InStr(1, F, "!") - 11)
End If
'Re-position, re-write & display the text box.
With ActiveSheet.TextBoxes(1)
.Left = (CurrentX / 1.333) + TLLeft + 5
.Top = (CurrentY / 1.333) + TLTop + 12
On Error GoTo WorkbookNotOpen
.Characters(1).Insert String:= _
Workbooks(SeriesWorkbook). _
Worksheets(SeriesWorksheet). _
Range(SeriesRange) _
.Offset(PointIndex - 1, 1).Resize(1, 1).Value
On Error GoTo 0
.AutoSize = True
.ShapeRange.ZOrder msoBringToFront
.Visible = msoTrue
End With
Exit Sub
WorkbookNotOpen: ActiveSheet.TextBoxes(1).Characters(1).Insert String:= _
"The workbook containing" & Chr(10) & _
"the source data for this" & Chr(10) & _
"chart needs to be open. "
Resume Next
Exit Sub
ChartIsNot3D: CurrentX = CurrentX - 1
CurrentY = CurrentY - 1
Resume Next
End Sub
Sub GetYoffset()
'Adds up the heights of all toolbars docked at the top of the screen.
'If multiple Toolbars share the same RowIndex, only one is counted.
Yoffset = 0
ReDim TheArray(0)
For Each bar In Application.CommandBars
If bar.Visible = True And bar.Position = msoBarTop Then
For I = 1 To UBound(TheArray)
If TheArray(I) = bar.RowIndex Then _
Yoffset = Yoffset - bar.Height _
: Exit For
Next I
Yoffset = Yoffset + bar.Height
Counter = Counter + 1
ReDim Preserve TheArray(Counter)
TheArray(Counter) = bar.RowIndex
End If
Next
'Accounts for the height of the Windows caption bar.
Yoffset = Yoffset + GetSystemMetrics(SM_CYCAPTION)
'Accounts for the height of the Formula Bar.
If Application.DisplayFormulaBar = True Then
Yoffset = Yoffset + 17
End If
'Accounts for the height of Column Headers.
On Error Resume Next
If ActiveWindow.DisplayHeadings = True Then
Yoffset = Yoffset + 17
End If
On Error GoTo 0
End Sub
Sub GetXoffset()
'Adds up the widths of all toolbars docked at the left of the screen.
'If multiple Toolbars share the same RowIndex, only one is counted.
Xoffset = 0
ReDim TheArray(0)
For Each bar In Application.CommandBars
If bar.Visible = True And bar.Position = msoBarLeft Then
For I = 1 To UBound(TheArray)
If TheArray(I) = bar.RowIndex Then _
Xoffset = Xoffset - bar.Width _
: Exit For
Next I
Xoffset = Xoffset + bar.Width
Counter = Counter + 1
ReDim Preserve TheArray(Counter)
TheArray(Counter) = bar.RowIndex
End If
Next
'Makes an adjustment if any toolbars are docked at the left.
If Xoffset > 0 Then Xoffset = Xoffset - 1
'Accounts for the width of Row Headers.
On Error Resume Next
If ActiveWindow.DisplayHeadings = True Then
Xoffset = Xoffset + 26
'If your charts are near row 1000 or row 10000 ,
'you may need to adjust the values 963 & 9963 .
If ActiveWindow.ScrollRow > 963 Then Xoffset = Xoffset + 7
If ActiveWindow.ScrollRow > 9963 Then Xoffset = Xoffset + 7
End If
On Error GoTo 0
End Sub
Sub XTipsOff()
With Application
.OnTime NextTime, "XTipsOn", schedule:=False
.Cursor = xlDefault
.StatusBar = False
.ShowChartTipNames = True
.ShowChartTipValues = True
End With
ActiveSheet.TextBoxes(1).Visible = msoTrue
End Sub
**********************************
DID YOU KNOW?...
that if you upgrade only to Excel 2000 instead of Office 2000 that you
cannot create interactive web pages. Unless you manipulate vast amounts
of data, the creation of interactive web pages is really the only major
change in Excel 2000 vs. Excel 97. Most users/power users might think that
this is not a compelling reason to upgrade. However, even if you don't
currently make web pages, you likely will soon since this interactivity
allows for the placement of virtually any calculation model into an online
environment, making everyone's worksheet constructs available to everyone
on the company Intranet. Thus, the upgrade to Office 2000 is a must!
**********************************
Issue No.6 OF EEE (PUBLISHED 01Jun1999)
Next issue scheduled for 16Jun1999.
BY David Hager
dchager@compuserve.com
Excel Expert Newsletter Archives
Here you'll find the archives of David Hager's Excel Expert's E-Letter, produced in 1999-2001. This information is old and unorganized, but it's here because it still contains lots of useful information. The newsletters contains quite a few links. Needless to say, most are no longer valid.
It's interesting to note that some of the key problems back then are still key problems today.