## Calculating National Insurance

Create the cells above and create names for each of the values from the names in the left column.

Two functions are available, one for employee national insurance, one for employer.

The calls are

=NationalInsurance(50000.0,Lower_Earnings_Threshold,Upper_Earnings_Threshold,Class_1,Class_1___4)

=EmployerNationalInsurance(50000.0,Lower_Earnings_Threshold,Class_1___Secondary)

The code for these functions is this

`Function NationalInsurance( _   income As Double, _   lowerearnings As Double, _   upperearnings As Double, _   classonerate As Double, _   secondaryrate As Double _   ) As Double   NationalInsurance = 0#   If income <= lowerearnings Then               Exit Function       End If       If income <= upperearnings Then               NationalInsurance = (income - lowerearnings) * classonerate       Else               NationalInsurance = (upperearnings - lowerearnings) * classonerate + (income - upperearnings) * secondaryrate       End If     End Function Function EmployerNationalInsurance( _   income As Double, _   lowerearnings As Double, _   secondaryrate As Double _   ) As Double   EmployerNationalInsurance = 0#   If income <= lowerearnings Then       Exit Function   End If   EmployerNationalInsurance = (income - lowerearnings) * secondaryrateEnd Function`

## Calculating UK Tax

With this as a table, the following function call can be made from Excel

=IncomeTax(50000.0,TaxRates)

To calculate the tax paid. TaxRates is the range above.

The code for this is as follows.

`Function IncomeTax(income As Double, rates As Range) As Double    Dim i As Integer    Dim tax As Double    tax = 0    For i = 1 To rates.Rows.Count - 1        tax = tax + Application.Min(income, rates.Cells(i, 1)) * rates.Cells(i, 2)        income = Application.Max(0, income - rates.Cells(i, 1))    Next i    IncomeTax = tax + income * rates.Cells(rates.Rows.Count, 2)End Function`

### Monday, August 14, 2006

We often are given a chunk of data in Excel that we need to explore. Of course, the first tool you should pull out of your toolbox in cases like this is the trusty PivotTable (it slices, it dices!). But at times we have to dig a little deeper into the toolbox and pull out the in-cell bar chart. Here’s what it looks like.

## Creating Names

Here is a better way to create a named range.

`ActiveWorkbook.Names.Add     Name:="Data",     RefersToR1C1:="=" &     Worksheets("Data").Cells(1, 1).CurrentRegion.Address(True, True, xlR1C1, False)`

The secret is in using the Address method to generate a name that can be used by
the Add method on a names collection.

Why didn't Microsoft allow Excel to do the following

` Range.Name = "Fred"`

as an operation?

## Amazon.co.uk: Spreadsheet Check and Control: 47 key practices to detect and prevent errors: Books

Amazon.co.uk: Spreadsheet Check and Control: 47 key practices to detect and prevent errors: Books

Learn how to: increase efficiency by avoiding rework; discover powerful formula auditing techniques; foil attempts to conceal data and formulas from you; reduce worry about costly and embarrassing mistakes; create spreadsheets faster by avoiding wasted time from lack of specification; present results with more confidence knowing that you have checked for errors; benefits to your organisation; ensure data quality and accuracy; protect against formula and operational errors; be able to demonstrate management of material risks; increase controls over spreadsheet based financial reporting; and reduce compliance costs for businesses in regulated sectors.

## Buggy spreadsheets: Russian roulette for the corporation | The Register

Buggy spreadsheets: Russian roulette for the corporation The Register: "How many scenarios can you imagine where a momentary loss of concentration could cost over \$1bn? Perhaps a nuclear power station meltdown...or if a currency trader hit a few wrong keys? Well, another possibility is a simple spreadsheet error.
In October 2003, soon after announcing third quarter earnings, Fannie Mae had to restate its unrealised gains, increasing them by \$1.2bn. This highly unwelcome outcome was said to stem from 'honest mistakes made in a spreadsheet used in the implementation of a new accounting standard'.
The really, really bad news is that millions of similar errors are almost certainly being made every year, many of them in business-critical financial spreadsheets. Although they are the quintessential end-user tool, spreadsheets of any complexity are just as hard to write and maintain as any other kind of software - if they are to yield consistently accurate results, anyway."

Interesting article with several references to other articles about errors in spreadsheets.

## Create Custom Menu Items in Excel VBA

Create Custom Menu Items in Excel VBA

## Returning an array of values

http://www.cpearson.com/excel/returnin.htm

How to return an array of values in VBA using a range function.

## Rule 20: User Name

``  ' Declare for call to mpr.dll.   Declare Function WNetGetUser Lib "mpr.dll" _      Alias "WNetGetUserA" (ByVal lpName As String, _      ByVal lpUserName As String, lpnLength As Long) As Long   Const NoError = 0       'The Function call was successful   Sub GetUserName()      ' Buffer size for the return string.      Const lpnLength As Integer = 255      ' Get return buffer space.      Dim status As Integer      ' For getting user information.      Dim lpName, lpUserName As String      ' Assign the buffer size constant to lpUserName.      lpUserName = Space\$(lpnLength + 1)      ' Get the log-on name of the person using product.      status = WNetGetUser(lpName, lpUserName, lpnLength)      ' See whether error occurred.      If status = NoError Then         ' This line removes the null character. Strings in C are null-         ' terminated. Strings in Visual Basic are not null-terminated.         ' The null character must be removed from the C strings to be used         ' cleanly in Visual Basic.         lpUserName = Left\$(lpUserName, InStr(lpUserName, Chr(0)) - 1)      Else         ' An error occurred.         MsgBox "Unable to get the name."         End      End If      ' Display the name of the person logged on to the machine.      MsgBox "The person logged on this machine is: " & lpUserName   End Sub``

## Rule 19: Machine Name

``Private Declare Function GetComputerName Lib "kernel32" _    Alias "GetComputerNameA" _    (ByVal lpBuffer As String, nSize As Long) As LongFunction ReturnComputerName() As StringDim rString As String * 255, sLen As Long, tString As String    tString = ""    On Error Resume Next    sLen = GetComputerName(rString, 255)    sLen = InStr(1, rString, Chr(0))    If sLen > 0 Then        tString = Left(rString, sLen - 1)    Else        tString = rString    End If    On Error GoTo 0    ReturnComputerName = UCase(Trim(tString))End Function``

## Rule 18: Using DB Code

Here is an example of using the DB Code

``' Load Duration sheetSub Load_Duration()    Dim sqlQry As String    Dim ds As String    Dim dbConn As ADODB.Connection        ds = Format(Worksheets("Main").Range("Risk_Date"), "YYYYMMDD")    sqlQry = "select isin, duration, date from durations where date = '" & ds & "'"    WSDuration.Range("Duration").ClearContents        Set dbConn = Db.OpenConnection_ODBC(GetDBParams("FASER", "_SERVER"), _                                        GetDBParams("FASER", "_DB"), _                                        GetDBParams("FASER", "_USER"), _                                        GetDBParams("FASER", "_PASSWORD"))    Call SQLToRangeName(dbConn, sqlQry, WSDuration, "Duration", True)        If WSDuration.Range("Duration").Rows.count < 2 Then         AddLogItem ("Load_Duration : Warning - no data retrieved for Duration")    End IfEnd Sub``

Pretty easy. The parameters are straight forward extracts from a sheet or a parameter file.

Setting up the sql query is easy.

Results go to one sheet.

To further use the results, vlookups are the easy way. That means the first column should be the key for the table. The vlookup is then

=vlookup (key, Duration, 2, FALSE)

## Rule 18: Centralise DB code

Here is some centralised DB access code

``Option ExplicitPrivate Enum ConnectionType    MSAccess = 0    Sybase = 1End EnumPrivate liveConnections As CollectionPrivate Sub AddLiveConnection     (    ByVal key As String,     ByRef theConnection As adodb.connection    )    Call CheckLiveConnections    If Trim(key) <> "" _            And Not (theConnection Is Nothing) _            And LiveConnectionExists(key) = False _            And theConnection.State = adodb.adStateOpen _            Then        liveConnections.Add theConnection, key    End IfEnd SubPrivate Function GetLiveConnection(ByVal key As String) As adodb.connection    CheckLiveConnections    If CollectionItemExists(liveConnections, key) Then        Set GetLiveConnection = liveConnections(key)    Else        Set GetLiveConnection = Nothing    End IfEnd FunctionPrivate Function LiveConnectionExists(ByVal key As String) As Boolean    Dim db As adodb.connection        Call CheckLiveConnections    If CollectionItemExists(liveConnections, key) Then        Set db = liveConnections(key)        If db.State = adStateOpen Then            LiveConnectionExists = True        Else            'The connection must have existed, but was not open, so delete it.            Set db = Nothing            liveConnections.Remove (key)        End If    End IfEnd FunctionPrivate Sub CheckLiveConnections()    'Need to check that the liveConnections array exists, as it may have died previously.    If liveConnections Is Nothing Then        Set liveConnections = New Collection    End IfEnd SubPrivate Function GetDBConnection    (    ByVal connType As ConnectionType,     ByVal info As String    ) As adodb.connection    Dim odbcStr As String        On Error GoTo ErrorHandler        'Open a connection to the database    Set GetDBConnection = New adodb.connection        Select Case connType        Case ConnectionType.MSAccess            'For access databases the info is the file path of the database            odbcStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=""" & info & """"        Case ConnectionType.Sybase            'For Sybase databases the info is the odbc string            odbcStr = info & "Driver={SYBASE ASE ODBC Driver};"    End Select        GetDBConnection.ConnectionString = odbcStr    GetDBConnection.Open        Exit Function    ErrorHandler:    MsgBox Err.Description    End FunctionPublic Function OpenConnection_Access(ByVal pathMDB As String) As adodb.connection    On Error GoTo ErrorHandler        Set OpenConnection_Access = GetDBConnection(MSAccess, pathMDB)        Exit Function    ErrorHandler:    MsgBox Err.Description    End FunctionPublic Function OpenConnection_ODBC    (    ByVal server As String,     ByVal db As String,     ByVal user As String,     ByVal password As String    ) As adodb.connection    On Error GoTo ErrorHandler        Dim odbcString As String    Dim key As String    'Build the key for the collection    key = server & "_" & db & "_" & user        'Return the connection if it exists already    If LiveConnectionExists(key) Then        Set OpenConnection_ODBC = GetLiveConnection(key)    Else        odbcString = odbcString & "Srvr=" & server & ";"        odbcString = odbcString & "Database=" & db & ";"        odbcString = odbcString & "Pwd=" & password & ";"        odbcString = odbcString & "uid=" & user & ";"        Set OpenConnection_ODBC = GetDBConnection(Sybase, odbcString)        Call AddLiveConnection(key, OpenConnection_ODBC)    End If        Exit Function    ErrorHandler:    MsgBox Err.Description    End FunctionPublic Sub CloseDBConnection(ByRef dbConn As adodb.connection)    On Error GoTo ErrorHandler        'If there is a connection shut it down.    If Not (dbConn Is Nothing) Then        If dbConn.State = adodb.adStateOpen Then            dbConn.Close        End If        Set dbConn = Nothing    End If        Exit Sub    ErrorHandler:    MsgBox Err.Description    End SubPrivate Function SQLRecordset    (    ByRef dbConn As adodb.connection,     ByVal sql As String    ) As adodb.Recordset    On Error GoTo ErrorHandler        Dim rs As adodb.Recordset        If Not (dbConn Is Nothing) Then        'Open a recordset        Set rs = New adodb.Recordset        Call rs.Open(sql, dbConn, adOpenForwardOnly)        Set SQLRecordset = rs    Else        MsgBox "Cannot open recordset when there is no active database connection"    End If        Exit Function    ErrorHandler:    MsgBox Err.Description    End FunctionPublic Function SQLToArray    (    ByRef dbConn As adodb.connection,     ByVal sql As String    ) As Variant    On Error GoTo ErrorHandler        Dim rs As adodb.Recordset        If Not (dbConn Is Nothing) Then        'Open a recordset        Set rs = New adodb.Recordset        Call rs.Open(sql, dbConn, adOpenDynamic)        SQLToArray = rs.GetRows()    Else        MsgBox "Cannot open recordset when there is no active database connection"    End If        Exit Function    ErrorHandler:    MsgBox Err.Description    End FunctionPublic Sub SQLToRangeName    (    ByRef dbConn As adodb.connection,     ByVal sql As String,     ByRef WSTarget As Worksheet,     ByVal rangeNameTarget As String,     ByVal headers As Boolean,     Optional ByVal cursorType As adodb.CursorTypeEnum = adodb.CursorTypeEnum.adOpenDynamic    )                                    On Error GoTo ErrorHandler        Dim rs As adodb.Recordset    Dim rng As Range    Dim rowCount As Long    Dim fieldCount As Integer        Set rng = WSTarget.Range(rangeNameTarget)        If Not (dbConn Is Nothing) Then        'Open a recordset        Set rs = New adodb.Recordset        Call rs.Open(sql, dbConn, cursorType)                'Copy the headers if required        If headers Then            For fieldCount = 0 To rs.Fields.Count - 1                rng.Cells(1, fieldCount + 1).Value = rs.Fields(fieldCount).Name            Next fieldCount        End If                'Copy all the records        rowCount = rng.Cells(IIf(headers, 2, 1), 1).CopyFromRecordset(rs)                'Check the sizes for the range        rowCount = rowCount + IIf(headers, 1, 0)        If rowCount = 0 Then rowCount = 1        If fieldCount = 0 Then fieldCount = 1                'Resize the range        Dim TheSheet As String        Dim TopLeft As String        Dim BottomRight As String        Dim RefersToString As String                    TheSheet = rng.Worksheet.Name        TopLeft = rng.Cells(1, 1).address        BottomRight = rng.Cells(rowCount, fieldCount).address        RefersToString = "='" & TheSheet & "'!" & TopLeft & ":" & BottomRight        Application.Names(rangeNameTarget).refersTo = RefersToString    Else        MsgBox "Cannot open recordset when there is no active database connection"    End If        Exit Sub    ErrorHandler:    MsgBox Err.Description    End SubPublic Function SQLExecute    (    ByRef dbConn As adodb.connection,     ByVal sql As String    ) As Long    On Error GoTo ErrorHandler    Dim recordsAffected As Long        If Not (dbConn Is Nothing) Then        'Run the SQL        Call dbConn.Execute(sql, recordsAffected)    Else        MsgBox "Cannot open recordset when there is no active database connection"    End If    SQLExecute = recordsAffected        Exit Function    ErrorHandler:    MsgBox Err.Description    End Function``

## Rule 17: Logging

Two major problems

1. Users are very bad at reporting errors.
2. No one knows what systems attach to particular data sources.

There is a solution that fixes both.

When accessing data, you should go through a common code routine. This can then determine the following

2. database name
3. database server
4. database user
5. local user
6. local machine
7. timestamp
8. success or failure
9. name of the query

Now, this can all be logged to a very simple central database.

Any failures can be reported on easily. A simple asp website is enough to report.

Now if a database moves, you can tell which spreadsheets need changing.
You know about any errors in extracting data
You know who accesses what data.

Subscribe to Posts [Atom]