Excel

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) * secondaryrate
End Function

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

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.

link

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

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: "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

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

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

  ' 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

Private Declare Function GetComputerName Lib "kernel32" _
    Alias "GetComputerNameA" _
    (ByVal lpBuffer As String, nSize As Long) As Long


Function ReturnComputerName() As String
Dim 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

Here is an example of using the DB Code

' Load Duration sheet
Sub 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 If
End 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)

Here is some centralised DB access code

Option Explicit

Private Enum ConnectionType
    MSAccess = 0
    Sybase = 1
End Enum

Private liveConnections As Collection


Private 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 If
End Sub

Private Function GetLiveConnection(ByVal key As String) As adodb.connection
    CheckLiveConnections
    If CollectionItemExists(liveConnections, key) Then
        Set GetLiveConnection = liveConnections(key)
    Else
        Set GetLiveConnection = Nothing
    End If
End Function

Private 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 If
End Function

Private 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 If
End Sub

Private 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 Function

Public 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 Function

Public 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 Function



Public 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 Sub

Private 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 Function

Public 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 Function

Public 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 Sub


Public 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

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

1. spreadsheet name
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.