I saw a spreadsheet with some VBA macros recently to calculate numbers of seats awarded in elections conducted using the d’Hondt system, so I thought I’d have a go at a single Excel function to do the same. WordPress doesn’t allow the Excel workbooks with VBA to be uploaded, so the file which can be downloaded from this link needs to have the following code added in a module
d’Hondt workbook – with VBA stripped
Option Explicit
Public Function dHondt(iSeatsToAllocate As Integer, rVotes)
Dim dVoteTotal As Double
Dim dVote
Dim i As Integer
Dim aSeats()
Dim aSeatsTransposed()
Dim aVotes
Dim dVotes() As Double
Dim blnColumn As Boolean
Dim dSeatCostTrial As Double
Dim nSeatsTrial As Integer
Dim nParties As Integer
Dim iTries As Integer
Dim dUpperLimit As Double, dLowerLimit As Double
Select Case TypeName(rVotes)
Case "Range"
aVotes = rVotes.Value
Case "Array"
aVotes = rVotes
Case Else
Err.Raise 1, "", ""
End Select
On Error Resume Next
blnColumn = UBound(aVotes, 2) <= 1
If Err.Number <> 0 Then 'single dim array
ReDim dVotes(UBound(aVotes) - LBound(aVotes))
For i = 0 To UBound(aVotes) - LBound(aVotes): dVotes(i) = aVotes(i + LBound(aVotes)): Next
ElseIf blnColumn Then
ReDim dVotes(UBound(aVotes) - LBound(aVotes))
For i = 0 To UBound(aVotes) - LBound(aVotes): dVotes(i) = aVotes(i + LBound(aVotes), LBound(aVotes, 2)): Next
Else
ReDim dVotes(UBound(aVotes, 2) - LBound(aVotes, 2))
For i = 0 To UBound(aVotes, 2) - LBound(aVotes, 2): dVotes(i) = aVotes(LBound(aVotes), i + LBound(aVotes, 2)): Next
End If
On Error GoTo 0
nParties = UBound(dVotes) + 1
For Each dVote In dVotes
dVoteTotal = dVoteTotal + dVote
Next
dSeatCostTrial = dVoteTotal / iSeatsToAllocate ' - always high
dUpperLimit = dSeatCostTrial
While nSeatsTrial <> iSeatsToAllocate
iTries = iTries + 1
ReDim aSeats(nParties - 1)
nSeatsTrial = 0
For i = 0 To nParties - 1
aSeats(i) = Int(dVotes(i) / dSeatCostTrial)
nSeatsTrial = nSeatsTrial + aSeats(i)
Next
If nSeatsTrial > iSeatsToAllocate Then ' adjust dSeatCostTrial up
If dSeatCostTrial > dLowerLimit Then dLowerLimit = dSeatCostTrial
ElseIf nSeatsTrial < iSeatsToAllocate Then ' adjust dSeatCostTrial up
If dSeatCostTrial < dUpperLimit Then dUpperLimit = dSeatCostTrial
End If
If dLowerLimit = 0 Then ' before we have found any other lower limit
dSeatCostTrial = dSeatCostTrial * nSeatsTrial / iSeatsToAllocate
Else
dSeatCostTrial = (dUpperLimit + dLowerLimit) / 2
End If
Wend
If blnColumn Then
ReDim aSeatsTransposed(nParties - 1, 0)
For i = 0 To nParties - 1: aSeatsTransposed(i, 0) = aSeats(i): Next
dHondt = aSeatsTransposed
Else
dHondt = aSeats
End If
End FunctionThe function needs first the number of seats to allocate, and then an Excel row or column range with the votes cast, or percentages, so something like
={dhondt(Q$3,Q$4:Q$13)}
The output is another Excel range, a row or column as the case may be, with the number of seats awarded under d’Hondt. Those curly braces are the result of the function being entered as an array formula – something to look up for those unfamiliar with these.
I’ve also written it so that it can be used more simply in VBA with just a single dimension array as the second argument.
Copyright? I’m really not too bothered, and I’m sure plenty of other people have done something like this, but yes, acknowledgement is appreciated.
Tim Lund
23rd April, 2019
