MS Access Function Collection that can be used to Generate Housing Forecast Figures

Apologies if you are coming here for the first time. This post is a somewhat dense domain specific holding post for some work I did at the weekend to pull together some thoughts.

I was thinking that if I had a list of all sites in the UK I should be able to generate a phasing for each of them based on maybe the area of the site. This would automatically create a general housing land audit for any site that I should put in. I thought I’d try and see if I could write a set of functions that might generate phasing by site. Given that you can get an estimate of the housing boundaries from open street map and that you can get their area it would be possible to get an estimated number of houses per site which could then be used to phase. Going further if you were ever to know planning permission dates you could more accurately use this as a date from which to start phasing.

Ensure you have three tables
T01Sites (PKID, TotalNoHouses, DecisionDate)
T02HousePhasing (PKID, SiteFKID, Year, Completions)
T03 (PKID, TotalNoHouses, DecisionDate, YearofDecision, YearofStart, YearSpread)

T02 is the phasing child table of T01 and T03 is a holding table for a make table that will hold a randomised spread over which you wish to phase the total no of houses. It also randomly predicts when the housing will start on site.

And three queries

Q01 – Make Table Query
SELECT T01Sites.PKID, T01Sites.SiteName, T01Sites.TotalNoHouses, T01Sites.DecisionDate, Year([DecisionDate]) AS YearofDecision, CalculateintYearStartFULLPP([YearofDecision]) AS YearofStart, intYearSpread([TotalNoHouses]) AS YearSpread INTO T03
FROM T01Sites;

Q02 – Select Query
SELECT T03.PKID, T03.SiteName, T03.TotalNoHouses, T03.DecisionDate, T03.YearofStart, T03.YearSpread, Int(T03!TotalNoHouses/T03!YearSpread) AS PerYearSpread, [TotalNoHouses] Mod [YearSpread] AS Remainder
FROM T03
WHERE ((([TotalNoHouses] Mod [YearSpread])=0));

Q03 – Select Query
SELECT T03.PKID, T03.SiteName, T03.TotalNoHouses, T03.DecisionDate, T03.YearofStart, T03.YearSpread, Int(T03!TotalNoHouses/T03!YearSpread) AS PerYearSpread, [TotalNoHouses] Mod [YearSpread] AS Remainder
FROM T03
WHERE ((([TotalNoHouses] Mod [YearSpread])>0));

VBA Function list
The first function randomises the spread in years over which construction might happen on an individual housing site based on the total number of houses on the site.
Public Function intYearSpread(TotalNoHouses As Integer) As Integer

If TotalNoHouses < 2 Then intYearSpread = 1 ElseIf TotalNoHouses = 2 Then intYearSpread = Int((TotalNoHouses) * Rnd) + 1 ElseIf TotalNoHouses > 2 And TotalNoHouses < 9 Then intYearSpread = Int((TotalNoHouses - 2 + 1) * Rnd + 1) ElseIf TotalNoHouses >= 9 And TotalNoHouses <= 40 Then intYearSpread = Int((4) * Rnd + 1) ElseIf TotalNoHouses >= 41 And TotalNoHouses <= 80 Then intYearSpread = Int((8 - 4 + 1) * Rnd + 4) ElseIf TotalNoHouses >= 81 And TotalNoHouses <= 200 Then intYearSpread = Int((8 - 4 + 1) * Rnd + 4) ElseIf TotalNoHouses >= 201 And TotalNoHouses <= 400 Then intYearSpread = Int((10 - 6 + 1) * Rnd + 6) ElseIf TotalNoHouses >= 401 And TotalNoHouses <= 800 Then intYearSpread = Int((12 - 8 + 1) * Rnd + 8) Else intYearSpread = Int((20 - 10 + 1) * Rnd + 10) End If 'MsgBox intYearSpread End Function

The first of the next three functions is used in the query to identify a year from which phasing on site will start. I wrote two further functions with the thought that in the future I could create a switch that would allow alternative site starts depending on whether a site has planning permission and depending on the type of planning permission. For example full planning permission would mean starting within three years of the granting of planning permission whereas outline would push it to between 3 and 6 years. A site with an LDP allocation would start further into the future.

Public Function CalculateintYearStartFULLPP(intDecisionDateYear As Integer) As Integer

CalculateintYearStartFULLPP = intDecisionDateYear + (Int((3 - 1 + 1) * Rnd + 1))

End Function

'Not used at present
Public Function CalculateintYearStartPPPP(intDecisionDateYear As Integer) As Integer

CalculateintYearStartPPPP = intDecisionDateYear + (Int((6 - 3 + 1) * Rnd + 3))

End Function

'Not used at present
Public Function CalculateintYearStartLDP(intDecisionDateYear As Integer) As Integer

CalculateintYearStartLDP = intDecisionDateYear + (Int((20 - 8 + 1) * Rnd + 8))

MsgBox CalculateintYearStartLDP

End Function

Function to create phasing IF housing IS perfectly divisible by Year Spread
GRH is an acronym for Generate Randomised Housing
Public Function GRHZero() As Variant

Dim db As DAO.Database
Dim rsSource As DAO.Recordset
Dim rsPhasing As DAO.Recordset
Dim intrsSourcePKID As Integer
Dim intrsSourceYearofStart As Integer
Dim intYearSpread As Integer
Dim intPerYearSpread As Integer
Dim i As Integer

Set db = CurrentDb()
Set rsSource = db.OpenRecordset("Q02")
Set rsPhasing = db.OpenRecordset("T02HousePhasing")

If Not (rsSource.EOF And rsSource.BOF) Then
'There are no records if End of File and Beginning of File are both true

rsSource.MoveFirst

Do Until rsSource.EOF = True

intrsSourcePKID = rsSource!PKID
intrsSourceYearofStart = rsSource!YearofStart
intYearSpread = rsSource!YearSpread
intPerYearSpread = rsSource!PerYearSpread

For i = 1 To intYearSpread

With rsPhasing
rsPhasing.AddNew
rsPhasing!SiteFKID = intrsSourcePKID
rsPhasing!Year = intrsSourceYearofStart
rsPhasing!Completions = intPerYearSpread
rsPhasing.Update
intrsSourceYearofStart = intrsSourceYearofStart + 1
End With

Next i

rsSource.MoveNext

Loop
Else
MsgBox "No Records"
Exit Function
End If

rsPhasing.Close
rsSource.Close

Set rsPhasing = Nothing
Set rsSource = Nothing

Set db = Nothing

End Function

Function to create phasing IF housing IS NOT perfectly divisible by Year Spread and a remainder is put on end
Public Function GRHRemainder() As Variant

Dim db As DAO.Database
Dim rsSource As DAO.Recordset
Dim rsPhasing As DAO.Recordset
Dim intrsSourcePKID As Integer
Dim intrsSourceYearofStart As Integer
Dim intYearSpread As Integer
Dim intPerYearSpread As Integer
Dim intRemainder As Integer
Dim i As Integer

Set db = CurrentDb()
Set rsSource = db.OpenRecordset("Q03")
Set rsPhasing = db.OpenRecordset("T02HousePhasing")

If Not (rsSource.EOF And rsSource.BOF) Then
'There are no records if End of File and Beginning of File are both true

rsSource.MoveFirst

Do Until rsSource.EOF = True

intrsSourcePKID = rsSource!PKID
intrsSourceYearofStart = rsSource!YearofStart
intYearSpread = rsSource!YearSpread
intPerYearSpread = rsSource!PerYearSpread
intRemainder = rsSource!Remainder

For i = 1 To intYearSpread

With rsPhasing
rsPhasing.AddNew
rsPhasing!SiteFKID = intrsSourcePKID
rsPhasing!Year = intrsSourceYearofStart
rsPhasing!Completions = intPerYearSpread
rsPhasing.Update
intrsSourceYearofStart = intrsSourceYearofStart + 1
End With

Next i

With rsPhasing
rsPhasing.AddNew
rsPhasing!SiteFKID = intrsSourcePKID
rsPhasing!Year = intrsSourceYearofStart
rsPhasing!Completions = intRemainder
rsPhasing.Update
intrsSourceYearofStart = intrsSourceYearofStart + 1
End With

rsSource.MoveNext

Loop
Else
MsgBox "No Records"
Exit Function
End If

rsPhasing.Close
rsSource.Close

Set rsPhasing = Nothing
Set rsSource = Nothing

Set db = Nothing

End Function

And the Script to run both the above functions
Public Function GeneratePhasingRecords()

Call GRHZero
Call GRHRemainder

MsgBox "Finished"

End Function

About Mark

Mark Brooks a forty something individual working and living in and around Edinburgh
This entry was posted in All, MS Access, VBA Code MS Access. Bookmark the permalink.