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
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 Function
The 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
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.
23rd April, 2019