Home ] Up ] MS Access Page ] SQL Server ] Tech Links ]

Useful Excel and VBA tricks and tips.
This page contains a whole lot of stuff I have found useful over the years.



Calculating MPH in Excel
Change start page number for printing
Convert Excel File to JPG or Picture
Create a shortcut on the desktop
Delete Row or Column and Capture event
Excel could not save all the data and formatting you recently added

Extract Unique List from a column of data

Find the current user's "MyDocuments" folder
Find the language version being used
Get Column Letter from VBA code
Get rid of Excel file bloat
List all available fonts
Loan Amortisation/Amortization calculation
Number formatting Explained
Open Userform in top corner of worksheet
Polar plots in Excel
Powerpoint and Excel
Test for Illegal Characters
Delete blank cells/rows in Excel using VBA
Get UNC server path using VBA

 
 

 
Delete Row and/or Delete Column Event:
[Back to Menu List]
Excel doesn't provide events for the deletion of rows and columns. There are two methods that you can use to determine if a user deletes a row, 
and they are described here. If you want to detect column deletion, the process is the same, but some of the details change.
Capture deleted Rows code is available here: http://www.dailydoseofexcel.com/archives/2006/08/21/capture-deleted-rows/

 
How do I find the current user's "MyDocuments" folder?
[Back to Menu List]
If you need to write a procedure that saves data to the MyDocuments folder but are having trouble getting around the username as
around the username as part of the path you need to have a look at "SpecialFolders".  See links for help
http://puremis.net/excel/code/035.shtml
http://msdn2.microsoft.com/en-us/library/aa140088(office.10).aspx
http://www.cpearson.com/excel/SpecialFolders.htm

 
Extract Unique List in Excel from a column of data?
[Back to Menu List]
 
You can use "Autofilter > Special" but I find this code to be faster and more effective
' -----------------------------------------------------------------------
Sub ExtractUniqueItems()
 
Dim lLR As Long
Dim MyColl As Collection
Dim vCell As Range
Dim MyArray()
Dim i As Integer
Application.screenupdating = false
   ' Find the last row in target range
   lLR = Sheet14.Cells(Rows.Count, "E").End(xlUp).Row
   If lLR = 5 Then
       Exit Sub
   End If

   ' Extract All Unique Descriptions
   Set MyColl = New Collection

   On Error Resume Next
   ' add unique items to collection
   For Each vCell In Sheet14.Range("F1:F" & lLR)
     MyColl.Add vCell, CStr(vCell)
   Next
   On Error GoTo 0

   'place collection of unique items in an array
   ReDim Preserve MyArray(1 To MyColl.Count)
   For i = 1 To MyColl.Count
     MyArray(i) = MyColl(i)
   Next i

   ' Write array to fixed data worksheet
   Sheet28.Range("A1").Resize(MyColl.Count, 1).Value = _
   Application.WorksheetFunction.Transpose(MyArray)

   lLR = Sheet28.Cells(Rows.Count, "A").End(xlUp).Row
   If lLR = 2 Then
       Exit Sub
   End If

   Sheet28.Range("A3:A" & lLR).Name = "nrUNIQUE_LIST"


End Sub
' -------------------------------------------

 
How do I find the language version of Windows and Excel is being used?
[Back to Menu List]

There are a couple of ways I have found that are useful.  One is to use an API call below
'-----------------------------------------------------------------------------
Declare Function GetSystemDefaultLangID Lib "kernel32.dll" () As Integer
Declare Function GetUserDefaultLangID Lib "kernel32.dll" () As Integer

Function WindowsInstallLanguage() As Integer
   WindowsInstallLanguage = GetSystemDefaultLangID
End Function

Function WindowsUserLanguage() As Integer
   WindowsUserLanguage = GetUserDefaultLangID()
End Function

Function ExcelInstallLanguage() as Integer
   ExcelInstallLanguage = _
       Application.LanguageSettings.LanguageID(msoLanguageIDInstall)
End Function

Function ExcelUserLanguage() as Integer
   ExcelUserLanguage = _
       Application.LanguageSettings.LanguageID(msoLanguageIDUI)
End Function

Function ExcelHelpLanguage() as Integer
   ExcelUserLanguage = _
       Application.LanguageSettings.LanguageID(msoLanguageIDHelp)
End Function


A table with the language ID codes can be found at
http://www.science.co.il/Language/Locale-Codes.asp

* thanks to Erich Neuwirth (Excel List)

------------------------------------------------------------------

Or as an alternative to the code above, consider using this approach within a formula itself.

=TEXT(A11,"[$-80A]mmmm")

Which is this example will return "Febrero" when A11 contains a date in February even though the computer's regional settings are set to English.

So how does the [$-80A] work and what other nifty things can be done with this type of formatting?

Rafael Aymá from the Excel-L list explains that the number in brackets is the way to tell Excel use the locale id language to display the name of the month(mmmm) or day of week(dddd), in the case of your formula hex 80A=decimal 2058 is the locale id for Spanish(Mexico) (as shown in http://www.science.co.il/Language/Locale-Codes.asp) so the names are being displayed in Spanish.

This is one way to display always dates in a specific language no matter which language is Windows or office, this feature is very useful when you create sheets that are going to be distributed and you don't know the language version of the target computers.

With thanks to Rafael Aymá


 
Is there a way of making a userform open in the very corner of the worksheet?
[Back to Menu List]
(or even better, open over a specified range on the worksheet), regardless of the size of the Excel Application and the
toolbars that the user has?  I found that a userforms ".Top" & ".Left" setting is from the top of the screen and the Range(??).top setting is
from the top of the worksheet and the Application.top setting is from the top of the screen.
 
Try:
.Top = Application.Height - Application.UsableHeight + Application.Top + 200
.Left = Application.Width - Application.UsableWidth + Application.Left + 220
(mod to suit) - thanks to Vincent Bayliss

 
Test for illegal characters in the filename:
[Back to Menu List]
'-------------------------------------------------------------------------------------
Sub tester()
x = ChkIllegalChar([G5], [IllegalChar])
If x = True Then
Exit Sub
Else
MsgBox "Looks good to me"
End If
End Sub
'-------------------------------------------------------------------------------------
Function ChkIllegalChar(myCel As Range, BadCharList As Range)
'Checks to make sure a cell does not have illegal characters as defined in
the range IllegalChar
' returns true if it finds illegal characters and false if it doesn't
For g = 1 To Len(myCel)
 For Each c In BadCharList
   If InStr(c, Mid(myCel, g, 1)) Then
     BadChar = Mid(myCel, g, 1)
     MsgBox "Found Illegal Character in File Name ==> " & c
     ChkIllegalChar = True
     Exit Function
   End If
 Next c
Next g
ChkIllegalChar = False
End Function
 
Thanks to George from Excel-L.
 

 
How to get the column letter (or column alpha) instead of the column number? :
[Back to Menu List]
This is what i use and it works great. Copy and paste the following code into a VBA module and try it out.

------------------------------------------------------- START OF CODE -----------------------------------------------------------------------------------
Option Explicit
'Returns the Alpha Version of the Column Number Reference
'Written by
'Bob McGill (Excel-L Developers List)
'United Space Alliance - Houston , Texas

Function GetLetter(ColNumber)
If ColNumber < 27 Then
GetLetter = Chr(((ColNumber - 1) Mod 26) + Asc("A"))
Else
GetLetter = Trim(Chr(Int((ColNumber - 1) / 26) + Asc("A") - 1) & Chr(((ColNumber - 1) Mod 26) + Asc("A")))
End If
End Function
'------------------------------------------------------- END OF CODE -----------------------------------------------------------------------------------

To return the Alpha value of the column use the following syntax


'------------------------------------------------------- START OF CODE -----------------------------------------------------------------------------------
Sub ShowMeColumnLetter()

Dim gsCOL_ALPHA As String

gsCOL_ALPHA = (GetLetter(ActiveCell.Column))

MsgBox gsCOL_ALPHA

End Sub
'------------------------------------------------------- END OF CODE -----------------------------------------------------------------------------------


Is it possible to start page numbering at a certain number, for example, 250?.
[Back to Menu List]
Yes, just follow the simple short steps at this link below.
http://exceltips.vitalnews.com/Pages/T0683_Changing_the_Starting_Page_Number.html

Thanks to Bonnie FMcKinnon, Excel G List


List all available fonts using VBA.
[Back to Menu List]
'--------------------------------------------
Do Until Err <> 0
   Cells(x + 1, 1) = Fonts.List(x)
   Cells(x + 1, 1).Font.Name = Fonts.List(x)
   x = x + 1
Loop
'--------------------------------------------
Thanks to Howard Groves, Excel G List


Using VBA code to create a shortcut on users' desktops
[Back to Menu List]

'----------------------------------------------------------------
Sub CreateShortCut()
Dim oWSH As Object
Dim oShortcut As Object
Dim sPathDeskTop As String

Set oWSH = CreateObject("WScript.Shell")
sPathDeskTop = oWSH.SpecialFolders("Desktop")

Set oShortcut = oWSH.CreateShortCut(sPathDeskTop & "\" & _
ActiveWorkbook.Name & ".lnk")
With oShortcut
.TargetPath = ActiveWorkbook.FullName
.Save
End With
Set oWSH = Nothing

End Sub
'----------------------------------------------------------------
Thanks to Bob Phillips, Excel-L mailing list


Clean up Excel bloat or how to minimise file size
[Back to Menu List]

'----------------------------------------------------------------

Sub ExcelDiet()

   Dim j As Long
   Dim k As Long
   Dim LastRow As Long
   Dim LastCol As Long
   Dim ColFormula As Range
   Dim RowFormula As Range
   Dim ColValue As Range
   Dim RowValue As Range
   Dim Shp As Shape
   Dim ws As Worksheet

   Application.ScreenUpdating = False
   Application.DisplayAlerts = False

   On Error Resume Next

   For Each ws In Worksheets
       With ws
           'Find the last used cell with a formula and value
           'Search by Columns and Rows
           On Error Resume Next
           Set ColFormula = .Cells.Find(What:="*", After:=Range("A1"), _
LookIn:=xlFormulas, _
                   LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious)
           Set ColValue = .Cells.Find(What:="*", After:=Range("A1"), _
LookIn:=xlValues, _
                   LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious)
           Set RowFormula = .Cells.Find(What:="*", After:=Range("A1"), _
LookIn:=xlFormulas, _
                   LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
           Set RowValue = .Cells.Find(What:="*", After:=Range("A1"), _
LookIn:=xlValues, _
                   LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
           On Error GoTo 0

           'Determine the last column
           If ColFormula Is Nothing Then
               LastCol = 0
           Else
               LastCol = ColFormula.Column
           End If
           If Not ColValue Is Nothing Then
               LastCol = Application.WorksheetFunction.Max(LastCol,
ColValue.Column)

           End If

           'Determine the last row
           If RowFormula Is Nothing Then
               LastRow = 0
           Else
               LastRow = RowFormula.Row
           End If
           If Not RowValue Is Nothing Then
               LastRow = Application.WorksheetFunction.Max(LastRow,
RowValue.Row)

           End If

           'Determine if any shapes are beyond the last row and last column
           For Each Shp In .Shapes
               j = 0
               k = 0
               On Error Resume Next
               j = Shp.TopLeftCell.Row
               k = Shp.TopLeftCell.Column
               On Error GoTo 0
               If j > 0 And k > 0 Then
                   Do Until .Cells(j, k).Top > Shp.Top + Shp.Height
                       j = j + 1
                   Loop
                   If j > LastRow Then
                       LastRow = j
                   End If
                   Do Until .Cells(j, k).Left > Shp.Left + Shp.Width
                       k = k + 1
                   Loop
                   If k > LastCol Then
                       LastCol = k
                   End If
               End If
           Next

           .Range(Cells(1, LastCol + 1).Address & ":IV65536").Delete
           .Range(Cells(LastRow + 1, 1).Address & ":IV65536").Delete
       End With
   Next

   Application.ScreenUpdating = True
   Application.DisplayAlerts = True

End Sub
'----------------------------------------------------------------
Thanks to Jim Poer, Excel-L mailing list


 
How can I convert an Excel or Word file to JPG or Picture?
[Back to Menu List]
 
Using VBA:
 
   Selection.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
   Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
Modify to suit
Thanks to David G Miley - Excel-L

 
Excel Number Formatting Explained (Simply):
[Back to Menu List]
 
Numbers are formatted in 3 sections - how they appear if positive, how they appear if negative, and how they appear if zero. 
So, for example: General;General;"-" OR #,##0_);(#,##0);"-" means that positive or negative numbers should be displayed in a general format, 
and zeros should be displayed as a dash.
There's a LOT more info on this, and you can get a start by looking in Excel help.
Thanks to Bob Umlas - MVP
 

 
Is it possible to make polar plots in Excel?
[Back to Menu List]
For example, angle and radial distance? An Example of how to do a polar plot chart in Excel is available here: http://people.stfx.ca/bliengme/ExcelTips/Polar.htm

 
Linking Excel and Powerpoint.
[Back to Menu List]
Linking to PowerPoint is not stable. Odd things tend to happen. I would suggest creating a macro to paste pictures. Have a look at
http://www.peltiertech.com/Excel/XL_PPT.html - (Damon Longworth - Microsoft Excel MVP)
 
If you need help with Powerpoint or really want to try this have poke around in here:  www.pptfaq.com

"Excel could not save all the data and formatting you recently added" error message.
[Back to Menu List]
This error message appears when you have applied conditional formatting to more than 2,050 rows. This is a limitation in the way that Excel saves information about your file.  This is one of those unhelpful error messages that Excel throws up at you. Whilst the workbook is saved, any conditional formatting over the row limit of 2,050 will be lost.

For full details see: http://support.microsoft.com/default.aspx?scid=kb;%5BLN%5D;215783


Loan Amortisation / Amortization calculation Explained

Norman Harker from the Excel list says it's inherently simple to replicate the bank's approach to mortgage amortization. The monthly repayments are calculated using the monthly effective rate amortizing over the number of months of the loan.
If the bank is using an APR12 rate (more correctly known as Nominal compounded monthly) you divide that rate by 12 to get monthly effective.

If the bank is using an annual effective rate, you use (1+i)^(1/12)-1 to get the equivalent monthly effective rate.

Once the monthly payment is calculated, the banks use the daily effective equivalent of the quoted rate on the daily outstanding balance to calculate
the amount of interest due between repayments. This automatically adjusts the interest element of the loan repayment for different length months (and
years).

Having calculated interest due from the last repayment that amount is deducted from the monthly repayment and the different represents principal
repayment that is then deducted from the outstanding balance. Interest components and principal components of the loan repayment thus vary from
month to month.

Now an example. Take a loan of $500,000 at an APR12 of 6%.  Repayments are made monthly over 25 years. Loan is drawn on 16th May 2008
and repayments will be on 16th of each month. These monthly payments will be:

=PMT(6%/12,25*12,500000,0,0)
Returns -$3221.51

Between 16th May and 16th Jun there are 31 days. As a result the interest in the first month will be:

=-500000*((1+(1+6%/12)^(12/365)-1)^(DATE(2008,6,16)-DATE(2008,5,16))-1)
Returns: -2548.07

Principal repaid is thus:
3221.51 - 2548.07
673.44

Balance at 16th Jun 2008 will thus be
500000 - 673.44
499,326.56

The way to set this up in a workbook is to set up a date based amortization table. Normal period number amortization schedules won't do the job as the
period vary in length. It isn't too difficult to grab the exponent for the interest calculation each month by deducting last month's date from this month's.

Where you will get problems replicating the bank's approach precisely is when repayments are not made on (my example) 16th of the month. That might
be the case where the bank deducts repayments on the due date OR the first working day after the due date if that falls on a weekend or public holiday.
But that starts to get anal retentive and the only complication is setting up the schedule of payment dates.

The art is the set up of the date schedule and calculating interest at the daily effective equivalent of the quoted rate.

But don't ask the banks to provide a schedule in advance. Their programs run on rolling day to day bases, doing the calculations as appropriate each day.

Thanks to Norman Harker (Excel L list - MVP)


Delete blank cells/rows in Excel using VBA:

I use the "Specialcells" method which is very fast and reliable (caveat: see below) - also Excel will delete 10,000 rows in about the same time as one, so you may was well do them all at once.

Sheet1.Range("rngMyRange").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
OR
Sheets("MySheet").Range("A5:A8000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

All done in a single line :)

NOTE: Be-careful with specialcells due to Excel limits.

See: http://www.rondebruin.nl/specialcells.htm for full details

if you hit the limit then apply the delete in a loop.

Of course you can also just sort the data and delete the blanks, or apply an autofilter on "blanks" and delete those rows as well.


Get UNC server path using VBA:

** Watch for Wrap **

Declare Function WNetGetConnection32 Lib "MPR.DLL" Alias _
"WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal _
lpszRemoteName As String, lSize As Long) As Long '#visible


Function GetNetPath(lpszLocalName As String) As String ' pass "Z:",
letter and colon
Dim lpszRemoteName As String, lStatus&
GetNetPath = lpszLocalName ' default return same string if
invalid

' Use for the return value of WNetGetConnection() API.
Const NO_ERROR As Long = 0

' The size used for the string buffer. Adjust this if you need a
larger buffer.
Const lBUFFER_SIZE As Long = 255

If UCase(lpszLocalName) Like "[A-Z]:*" Then ' syntax check first

' Prepare a string variable by padding spaces.
lpszRemoteName = Space$(lBUFFER_SIZE)

' Return the UNC path (\\Server\Share).
lStatus& = WNetGetConnection32(lpszLocalName, lpszRemoteName,
lBUFFER_SIZE)

' Verify that the WNetGetConnection() succeeded.
' WNetGetConnection() returns 0 (NO_ERROR) if it successfully
retrieves the UNC path.
If lStatus& = NO_ERROR Then

GetNetPath = Trim$(lpszRemoteName) ' the UNC path is in
lpszRemoteName, trim padded chrw$(0) away

End If

End If

End Function

Thanks to Patrick O'Beirne (Excel L mailing list)


Calculating the MPH in distance races using Excel?

Doug McNutt, who is the resident guru on all thing precise on the Excel-L list, says to trust the folks at the US NIST, (National Institute of Standards and Technology)
http://www.physics.nist.gov/cuu/Units/index.html
http://www.physics.nist.gov/cuu/Units/outside.html

He explains that a surprisingly real problem is that the answer to your question will involve the definition you choose to use for a mile. It's much less obvious than you think even with the inch being defined as exactly 2.54 centimeters the foot is not exactly 12 of those inches and the statute mile is 5280 feet of some kind or other. Surveyors, who might be laying out a race course, actually use different sized feet being defined as 12 of those things 39.37 of which make a meter. And then there is the nautical mile. . .

Time units seem to be pretty much the same world wide even though they are anything but metric. An hour is 60 * 60 seconds everywhere but in astronomy where it can be a unit of angle equal to 15 degrees. Excel divides up time in decimal fractions of a day but has a problem figuring out how many days there are in a year.

You might think such trivia are not important but races are won on a millisecond or two these days and that translates to a pretty small fraction of a foot.

NIST recommends these calculators:
http://www.digitaldutch.com/unitconverter/
http://www.megaconverter.com/Mega2/index.html

Thanks to Doug McNutt (Excel L mailing list)

 


Home ] Up ] MS Access Page ] SQL Server ] Tech Links ]