Sorting and counting data by Postcode area

[TalkieToaster]

Hi guys,

I have what is in my mind a rather complex problem, but which is probably childsplay to you Excel boffins

I've been playing around with this for a while and can't determine the best way to approach it.

In short, I have two columns of data produced by an external application; Age and Postcode. The raw data looks like this:

Excel 2010<table rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #BBB" cellpadding="2.5px"><colgroup><col style="background-color: #DAE7F5" width="25px"><col><col></colgroup><thead><tr style=" background-color: #DAE7F5;text-align: center;color: #161120"><th>
</th><th>E</th><th>F</th></tr></thead><tbody><tr><td style="color: #161120;text-align: center;">14</td><td style="font-weight: bold;;">Age</td><td style="font-weight: bold;;">Post Code</td></tr><tr><td style="color: #161120;text-align: center;">15</td><td style="text-align: right;;">29</td><td style=";">AB1 2GQ</td></tr><tr><td style="color: #161120;text-align: center;">16</td><td style="text-align: right;;">43</td><td style=";">AB1 3EZ</td></tr><tr><td style="color: #161120;text-align: center;">17</td><td style="text-align: right;;">41</td><td style=";">AB10 0DN</td></tr><tr><td style="color: #161120;text-align: center;">18</td><td style="text-align: right;;">20</td><td style=";">AB11 9PL</td></tr><tr><td style="color: #161120;text-align: center;">19</td><td style="text-align: right;;">54</td><td style=";">AB13 2RG</td></tr><tr><td style="color: #161120;text-align: center;">20</td><td style="text-align: right;;">21</td><td style=";">AB14 7EH</td></tr><tr><td style="color: #161120;text-align: center;">21</td><td style="text-align: right;;">59</td><td style=";">AB19 7HG</td></tr><tr><td style="color: #161120;text-align: center;">22</td><td style="text-align: right;;">32</td><td style=";">AB2 7AG</td></tr><tr><td style="color: #161120;text-align: center;">23</td><td style="text-align: right;;">21</td><td style=";">AB20 3AZ</td></tr><tr><td style="color: #161120;text-align: center;">24</td><td style="text-align: right;;">47</td><td style=";">AB9 7EE</td></tr><tr><td style="color: #161120;text-align: center;">25</td><td style="text-align: right;;">29</td><td style=";">X72 7RD</td></tr><tr><td style="color: #161120;text-align: center;">26</td><td style="text-align: right;;">25</td><td style=";">U/K</td></tr><tr><td style="color: #161120;text-align: center;">27</td><td style="text-align: right;;">51</td><td style=";">AB28 2JP</td></tr><tr><td style="color: #161120;text-align: center;">28</td><td style="text-align: right;;">20</td><td style=";">AB30 6UB</td></tr><tr><td style="color: #161120;text-align: center;">29</td><td style="text-align: right;;">50</td><td style=";">AB4 1BP</td></tr><tr><td style="color: #161120;text-align: center;">30</td><td style="text-align: right;;">26</td><td style=";">AB5 4HQ</td></tr></tbody></table>
That's only an example, the actual data is about 200 rows usually. As you can see, the ages and postcodes are in no particular order. What I need to do, is sort it so the postcodes are in ascending numerical order according to the numbers after the initial AB (the last three digits of the postcode are irrelevant and can be ignored), then sort the ages in ascending order grouped by the postcodes.

The end result of all this is I need to produce a table which shows a count of how many people in each particular age ranges reside in a particular district (which is a grouping of postcodes). The age ranges are: 18-19, 20-29, 30-39, 40-49, 50-59, 60+.

The postcodes are grouped into 8 districts as follows:
District 1: AB14, AB15, AB36
District 2: AB11, AB12, AB13, AB17
District 3: AB1, AB7, AB8, AB9, AB10
District 4: AB4, AB5, AB6, AB16
District 5: AB27, AB28, AB66, AB67
District 6: AB24, AB30, AB31, AB33
District 7: AB19, AB20, AB22, AB23
District 8 (OTHER): Any postcode which doesn't start AB (for example cells 25 and 26 above)

I know this sounds convoluted, but the end results simply look like this:

Excel 2010<table rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #BBB" cellpadding="2.5px"><colgroup><col style="background-color: #DAE7F5" width="25px"><col><col><col><col><col><col><col></colgroup><thead><tr style=" background-color: #DAE7F5;text-align: center;color: #161120"><th>
</th><th>D</th><th>E</th><th>F</th><th>G</th><th>H</th><th>I</th><th>J</th></tr></thead><tbody><tr><td style="color: #161120;text-align: center;">1</td><td style="text-align: right;;">
</td><td style="font-weight: bold;background-color: #B8CCE4;;">18-19</td><td style="font-weight: bold;background-color: #B8CCE4;;">20-29</td><td style="font-weight: bold;background-color: #B8CCE4;;">30-39</td><td style="font-weight: bold;background-color: #B8CCE4;;">40-49</td><td style="font-weight: bold;background-color: #B8CCE4;;">50-59</td><td style="font-weight: bold;text-align: right;background-color: #B8CCE4;;">60+</td></tr><tr><td style="color: #161120;text-align: center;">2</td><td style="font-weight: bold;background-color: #F2DCDB;;">District 1</td><td style="text-align: right;;">0</td><td style="text-align: right;;">12</td><td style="text-align: right;;">9</td><td style="text-align: right;;">8</td><td style="text-align: right;;">4</td><td style="text-align: right;;">1</td></tr><tr><td style="color: #161120;text-align: center;">3</td><td style="font-weight: bold;background-color: #F2DCDB;;">District 2</td><td style="text-align: right;;">0</td><td style="text-align: right;;">8</td><td style="text-align: right;;">5</td><td style="text-align: right;;">7</td><td style="text-align: right;;">0</td><td style="text-align: right;;">0</td></tr><tr><td style="color: #161120;text-align: center;">4</td><td style="font-weight: bold;background-color: #F2DCDB;;">District 3</td><td style="text-align: right;;">0</td><td style="text-align: right;;">7</td><td style="text-align: right;;">6</td><td style="text-align: right;;">9</td><td style="text-align: right;;">3</td><td style="text-align: right;;">0</td></tr><tr><td style="color: #161120;text-align: center;">5</td><td style="font-weight: bold;background-color: #F2DCDB;;">District 4</td><td style="text-align: right;;">2</td><td style="text-align: right;;">17</td><td style="text-align: right;;">19</td><td style="text-align: right;;">16</td><td style="text-align: right;;">3</td><td style="text-align: right;;">0</td></tr><tr><td style="color: #161120;text-align: center;">6</td><td style="font-weight: bold;background-color: #F2DCDB;;">District 5</td><td style="text-align: right;;">0</td><td style="text-align: right;;">4</td><td style="text-align: right;;">6</td><td style="text-align: right;;">7</td><td style="text-align: right;;">2</td><td style="text-align: right;;">0</td></tr><tr><td style="color: #161120;text-align: center;">7</td><td style="font-weight: bold;background-color: #F2DCDB;;">District 6</td><td style="text-align: right;;">1</td><td style="text-align: right;;">9</td><td style="text-align: right;;">3</td><td style="text-align: right;;">4</td><td style="text-align: right;;">2</td><td style="text-align: right;;">0</td></tr><tr><td style="color: #161120;text-align: center;">8</td><td style="font-weight: bold;background-color: #F2DCDB;;">District 7</td><td style="text-align: right;;">0</td><td style="text-align: right;;">9</td><td style="text-align: right;;">7</td><td style="text-align: right;;">4</td><td style="text-align: right;;">2</td><td style="text-align: right;;">0</td></tr><tr><td style="color: #161120;text-align: center;">9</td><td style="font-weight: bold;background-color: #F2DCDB;;">District 8 OTHER</td><td style="text-align: right;;">0</td><td style="text-align: right;;">2</td><td style="text-align: right;;">0</td><td style="text-align: right;;">0</td><td style="text-align: right;;">0</td><td style="text-align: right;;">0</td></tr></tbody></table>

I hope that makes sense.
I know this is probably a fairly simple process to do with a formula or even a small bit of VBA, but I'm not sure how to approach it. I looked at this thread and can sort the postcodes into ascending order by splitting off the 'AB' as described, but sorting them may not even be necessary if there was some COUNT formula I could use which was capable of counting the occurance of each age range and incrementing the number of that range in a particular postcode district.

Sorry if the above sounds vague, I hope the data samples help make more sense of it.
I'm not too bad with Excel but I would really appreciate any thoughts on how to approach this particular problem from some of you guys, you'll probably laugh at how simple it is, but I just can't see it!

I'm very grateful for any pointers

 

[MickG]

Try this:-
Place you data in columns "A & B" (Row 1= Headers)
Columns C & D used as helper columns.
Results sheet 2 starting "A1".
If this works for you it can be altered to be more userfriendly .

[COLOR="Navy"]Sub[/COLOR] MG03Jun42
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] range
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] range
[COLOR="Navy"]Dim[/COLOR] n           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Q
[COLOR="Navy"]Dim[/COLOR] ray(1 To 7)
[COLOR="Navy"]Dim[/COLOR] Dn1         [COLOR="Navy"]As[/COLOR] range
[COLOR="Navy"]Dim[/COLOR] K
[COLOR="Navy"]Dim[/COLOR] Ac          [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = range(range("B2"), range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Left(Dn, 2) = "AB" [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]Select[/COLOR] [COLOR="Navy"]Case[/COLOR] Split(Dn, " ")(0)
            [COLOR="Navy"]Case[/COLOR] "AB14", "AB15", "AB36": Dn.Offset(, 1) = "District1"
            [COLOR="Navy"]Case[/COLOR] "AB11", "AB12", "AB13", "AB17": Dn.Offset(, 1) = "District2"
            [COLOR="Navy"]Case[/COLOR] "AB1", "AB2", "AB7", "AB8", "AB9", "AB10": Dn.Offset(, 1) = "District3"
            [COLOR="Navy"]Case[/COLOR] "AB4", "AB5", "AB6", "AB16": Dn.Offset(, 1) = "District4"
            [COLOR="Navy"]Case[/COLOR] "AB27", "AB28", "AB66", "AB67": Dn.Offset(, 1) = "District5"
            [COLOR="Navy"]Case[/COLOR] "AB24", "AB30", "AB31", "AB33": Dn.Offset(, 1) = "District6"
            [COLOR="Navy"]Case[/COLOR] "AB19", "AB20", "AB22", "AB23": Dn.Offset(, 1) = "District7"
    [COLOR="Navy"]End[/COLOR] Select
[COLOR="Navy"]Else[/COLOR]
Dn.Offset(, 1) = "District8"
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Select[/COLOR] [COLOR="Navy"]Case[/COLOR] Dn.Offset(, -1)
    [COLOR="Navy"]Case[/COLOR] 18 To 19: Dn.Offset(, 2) = 1
    [COLOR="Navy"]Case[/COLOR] 20 To 29: Dn.Offset(, 2) = 2
    [COLOR="Navy"]Case[/COLOR] 30 To 39: Dn.Offset(, 2) = 3
    [COLOR="Navy"]Case[/COLOR] 40 To 49: Dn.Offset(, 2) = 4
    [COLOR="Navy"]Case[/COLOR] 50 To 59: Dn.Offset(, 2) = 5
    [COLOR="Navy"]Case[/COLOR] [COLOR="Navy"]Is[/COLOR] > 60: Dn.Offset(, 2) = 6
[COLOR="Navy"]End[/COLOR] Select
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn1 [COLOR="Navy"]In[/COLOR] Rng.Offset(, 1)
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn1.Value) [COLOR="Navy"]Then[/COLOR]
        n = n + 1
        ray(Dn1.Offset(, 1)) = 1
        .Add Dn1.Value, Array(ray, Dn1.Offset(, 1))
    [COLOR="Navy"]Else[/COLOR]
       Q = .Item(Dn1.Value)
       Q(0)(Dn1.Offset(, 1)) = Q(0)(Dn1.Offset(, 1)) + 1
        .Item(Dn1.Value) = Q
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
 c = 1
Sheets("Sheet2").UsedRange.ClearContents
Sheets("Sheet2").range("A1:G1") = Array("District", "18/19", "20/29", "30/39", "40/49", "50/59", ">60")
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .Keys
    c = c + 1
    Sheets("Sheet2").Cells(c, 1) = K
        [COLOR="Navy"]For[/COLOR] Ac = 1 To 6
            [COLOR="Navy"]If[/COLOR] IsEmpty(.Item(K)(0)(Ac)) [COLOR="Navy"]Then[/COLOR]
                Sheets("Sheet2").Cells(c, Ac + 1) = 0
            [COLOR="Navy"]Else[/COLOR]
                Sheets("Sheet2").Cells(c, Ac + 1) = .Item(K)(0)(Ac)
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
    .range("A2").Resize(c, 7).Sort .range("A2"), xlAscending
[COLOR="Navy"]End[/COLOR] With
MsgBox "Run"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[TalkieToaster]

Hi Mick,

Thank you so much for taking the time to reply and to write that extensive code.

I've given it a bash and its working 90% of the way, it steps through the postcodes and fills in columns C and D, correctly identifying the districts for each postcode and counting the accumulated ages.

However, its hiccuping with Subscript out of range at line 45:

Q(0)(Dn1.Offset(, 1)) = Q(0)(Dn1.Offset(, 1)) + 1

I'm just trying to understand what that lines doing, as far as I can see the else clause of that IF statement is attempting to increment the value Q by one if the item already exists in the sheet (its only executed if Dn1.value already exists in the sheet, if I'm correct). I'm not entirely sure why its dying at that point after successfully aggregating all the data, any ideas?

Thanks again for all your help, its very much appreciated.

 

[MickG]

Have you got any blank cells in "A or "B". this will give the error "Subscript out of Range".
If this is not the case , please Show an example of the Data it failed On.
I also noticed that PostCode "AB2" was not in the PostCode Groups , so as you will see, I added it in case (line 3).

 

[TalkieToaster]

You're quite right, there were indeed a few blank C and D rows originally (it seems the list of district postcodes I was given initially wasn't quite complete! :S), so I rectified that by adding the missing postcodes to their relevant districts, but its still getting the subscript out of range even though all values are complete.

It seems to crash after it finishes filling in C and D for every postcode, odd. I'll run it again now with a limited set of data and see if I can identify where its falling down.

 

[TalkieToaster]

Right, its running successfully for a limited selection of 10 rows, so there's obviously something in the original data it doesn't like, despite the fact rows C and D are processed for all entries.

In order to identify that I was thinking of having the loop write out the values to a text file line by line, that way it should be possibly to see where its stalling... brb

 

[TalkieToaster]

It was dying on a row with Age 60, Postcode AB14.

Upon investigation it was the age that was choking it, looked at the code and realised it was selecting case on > 60, which would in theory miss out 60 itself, so I changed it to > 59 and its executing successfully. I'm just making sure that won't skew any 59 ones

 

[MickG]

If you place these couple of lines in the code it will show you what in column "A & B" at the falure line. Make sure you clear "C & D" before each run else the code tries to use the previous values.

  Q(0)(Dn1.Offset(, 1)) = Q(0)(Dn1.Offset(, 1)) + 1
        On Error GoTo msg '[COLOR=seagreen] New code
[/COLOR]        .Item(Dn1.Value) = Q
End If
Next
msg: MsgBox Dn1.Offset(, -1) & "//" & Dn1.Offset(, -2)[COLOR=seagreen]'New code[/COLOR]

 

[TalkieToaster]

Thanks again, I'll give that a whirl, it would be helpful to trace what's happening because its doing something odd with the figures, I think its to do with the fact I changed the last case criteria to > 59 as opposed to 60, might need to alter it so it checks for = 60 OR >60.

Will try that now

 

[TalkieToaster]

It's working quite well now

I had to change the Select Case for > 59 to 60 to 99 instead as it was causing some discrepencies with counting ages 59 and failing to count 60 for some reason.

I also added a few bits to cleanup the sheets and variables at runtime, and a postcode error counter with a few dialogue boxes which notify the user of the row numbers of any potentially dodgy postcodes.

I added some documentation advising users how to amend postcodes in the districts, but ideally its probably better if they don't mess around in there and if I had more time I'd maybe like to have it retrieve the postcode and district data from a sheet if possible, but I've not had the chance to look at that yet.

Here's the code as it currently stands:

Sub MonthlyStats()

Dim Rng         As Range
Dim Dn          As Range
Dim n           As Long
Dim Q
Dim ray(1 To 7)
Dim Dn1         As Range
Dim K
Dim Ac          As Integer
Dim c           As Integer
Dim errPCode

'Cleanup before new run:
Sheets("Sheet1").Range("C1:D1").ClearContents
errPCode = 0

Set Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
For Each Dn In Rng
    
    Dn = UCase(Dn)
    If Left(Dn, 2) = "AB" Then
        
        Select Case Split(Dn, " ")(0)
        
        '######################################################################################
        '#####                  Postcode and area definitions                             #####
        '######################################################################################
        '#  Copy the existing format below to assign postcodes to their relevant areas.       #
        '#  Postcodes must appear only ONCE and area names must be *unique*.                  #
        '#  Insert postcodes in correct *ascending* numerical order.                          #
        '#  Note that the *last* postcode on the line must be followed by : rather than ,     #
        '#  Any postcode not starting AB will be automatically classified as 'Other'          #
        '######################################################################################
        
                
            Case "AB14", "AB15", "AB36": Dn.Offset(, 1) = "North District"
            Case "AB11", "AB12", "AB13", "AB17": Dn.Offset(, 1) = "West District"
            Case "AB1", "AB2", "AB7", "AB8", "AB9", "AB10": Dn.Offset(, 1) = "South District"
            Case "AB4", "AB5", "AB6", "AB16": Dn.Offset(, 1) = "East District"
            Case "AB25", "AB26", "AB27", "AB28", "AB66", "AB67": Dn.Offset(, 1) = "City District"
            Case "AB24", "AB30", "AB31", "AB33": Dn.Offset(, 1) = "Rurals District"
            Case "AB19", "AB20", "AB21", "AB22", "AB23": Dn.Offset(, 1) = "Specialist Units"
            
        '########################################################################################
        '# Remember, if a particular postcode in the spreadsheet isn't assigned to an area here #
        '# the results will be skewed and the program may crash with 'Subscript out of range'   #                         #
        '########################################################################################
        '###### Don't edit anything else outside of this section!                           #####
        '########################################################################################
    
    End Select
Else
Dn.Offset(, 1) = "Other"
End If
Select Case Dn.Offset(, -1)
    Case 18 To 19: Dn.Offset(, 2) = 1
    Case 20 To 29: Dn.Offset(, 2) = 2
    Case 30 To 39: Dn.Offset(, 2) = 3
    Case 40 To 49: Dn.Offset(, 2) = 4
    Case 50 To 59: Dn.Offset(, 2) = 5
    Case 60 To 99: Dn.Offset(, 2) = 6
End Select
Next Dn
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn1 In Rng.Offset(, 1)
    If Not .Exists(Dn1.Value) Then
        n = n + 1
        ray(Dn1.Offset(, 1)) = 1
        .Add Dn1.Value, Array(ray, Dn1.Offset(, 1))
    Else
       Q = .Item(Dn1.Value)
       Q(0)(Dn1.Offset(, 1)) = Q(0)(Dn1.Offset(, 1)) + 1
       
        .Item(Dn1.Value) = Q
        
        If Dn1.Value = "" Then 'Postcode not found in any district!
             
             MsgBox "Error on row " & Dn1.Row & " -" & vbCrLf & "Postcode " & Dn1.Offset(, -1) & _
             " isn't assigned to any area!" & vbCrLf & "Either remove the suspect postcode and manually count it, " & _
             "or edit the Macro and add the Postcode to an existing district.", vbInformation, "Postcode error!"

             errPCode = errPCode + 1
             
        End If

End If
Next



c = 1
Sheets("Sheet2").UsedRange.ClearContents
Sheets("Sheet2").Range("A1:G1") = Array("District", "18 - 19", "20 - 29", "30 - 39", "40 - 49", "50 - 59", "60+")
For Each K In .Keys
    c = c + 1
    Sheets("Sheet2").Cells(c, 1) = K
        For Ac = 1 To 6
            If IsEmpty(.Item(K)(0)(Ac)) Then
                Sheets("Sheet2").Cells(c, Ac + 1) = 0
            Else
                Sheets("Sheet2").Cells(c, Ac + 1) = .Item(K)(0)(Ac)
            End If
        Next Ac
Next K
End With
With Sheets("Sheet2")
    .Range("A2").Resize(c, 7).Sort .Range("A2"), xlAscending
End With

If errPCode > 0 Then 'There were problems with some postcodes
    MsgBox Now() & vbCrLf & vbCrLf & "Processing completed however there were errors with postcodes " & _
    "on " & errPCode & " rows." & vbCrLf & "Please check and correct these errors then run the program again." & vbCrLf & _
    "Results are available on Sheet 2 however these may not be accurate while postcode errors remain.", vbExclamation, "Completed with errors"

Else
    MsgBox Now() & vbCrLf & vbCrLf & "Processing seems to have completed with no errors :-)" & vbCrLf & vbCrLf & "See Sheet 2 for the results.", vbInformation, "Completed successfully"
End If

End Sub

Thanks again Mick for your help with this, I'd never have known where to even start! Much appreciated