View Single Post
  #10   Report Post  
Posted to microsoft.public.excel.programming
F[_2_] F[_2_] is offline
external usenet poster
 
Posts: 46
Default Counting (unknown at present) discrete values

On 07/05/2011 02:14 joeu2004 wrote:

On May 6, 1:28 pm, F<news@nowhere wrote:
I have a column that will hold postcodes from responses
to a questionnaire.

[....]
I would like to count how many instances there are of
each discrete postcode that appears.

[....]
Is there a (relatively) simple way to achieve this?


Define "relatively simple". For me, it's a macro. Granted, figuring
out the various machinations to make it happen can be a challenge.
But once that's done, perhaps it is "relatively simple" for you to
copy-and-paste the macro below into a VBA module, make the necessary
changes (see "Set src" and "Set dst"), then run the macro.

By the way, it is surprisingly fast. I tested it with a column of
65536 random postal codes, 20 unique ones. The macro completed in
about 0.9 sec on my 6-year-old computer (read: ancient!). YMMV.

Note: The macro is intended to handle postal codes that can be
entered as a number (e.g. 12345) intermixed with postal codes that
Excel interprets as text by default (e.g. 12345-1234). It should work
with numeric postal codes formatted as Custom 00000-0000 as well. But
I did not test that.

The macro....

Sub doit()
Dim oldCalc, p0, src As Range, dst As Range
Dim n As Long, i As Long, j As Long

'***** modify these *****
Set src = Range("b1") 'cell with first postal code
Set dst = Range("e1") 'target cell for list, 2 columns

oldCalc = Application.Calculation
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'src = column of contiguous cells
Set src = Range(src, src.End(xlDown))
n = src.Count

'convert all to text for sort so that
'12345-1234 follows 12345, for example
'(Text To Columns, format as Text)
src.TextToColumns Destination:=trg, DataType:=xlFixedWidth, _
FieldInfo:=Array(0, 2), TrailingMinusNumbers:=False

'sort in text order
dst.Resize(n).Sort Key1:=trg, Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

'create list of discrete postal codes
'count duplicates
p0 = dst.Resize(n)
dst.Resize(n, 2).Clear
ReDim p(1 To n, 1 To 2)
p(1, 1) = p0(1, 1): p(1, 2) = 1
j = 1
For i = 2 To n
If p0(i, 1) = p(j, 1) Then p(j, 2) = p(j, 2) + 1 _
Else j = j + 1: p(j, 1) = p0(i, 1): p(j, 2) = 1
Next
dst.Resize(j, 2) = p

Application.Calculation = oldCalc
Application.ScreenUpdating = True
End Sub


Amazing! Thank you!

I should have some 'real' data (UK postcodes in the format AB12 3CD)
later today so look forward to giving it some exercise...

--
F