|
Posted to microsoft.public.excel.programming
|
|
|
List & count unique records
On Mar 20, 6:58*pm, Sinner wrote:
On Mar 20, 6:36*pm, "Peter T" <peter_t@discussions wrote:
"Sinner" wrote in message
...
On Mar 19, 8:11 pm, Sinner wrote:
On Mar 19, 6:34 pm, "Peter T" <peter_t@discussions wrote:
"Sinner" wrote in message
...
On Mar 19, 5:40 pm, "Peter T" <peter_t@discussions wrote:
Another one -
Sub Dups7()
Dim i As Long, j As Long, nSame As Long
Dim arr1, arr2
Dim rng As Range
Set rng = ActiveSheet.Range("A1") ' < change to suit
Set rng = Range(rng, rng.End(xlDown))
arr1 = rng.Value
For i = 1 To UBound(arr1)
arr1(i, 1) = Left$(arr1(i, 1), 7)
Next
BubbleSort2D arr1
ReDim arr2(1 To UBound(arr1), 1 To 2)
nSame = 0
For i = 2 To UBound(arr1)
nSame = nSame + 1
If arr1(i - 1, 1) < arr1(i, 1) Then
j = j + 1
arr2(j, 1) = arr1(i - 1, 1)
arr2(j, 2) = nSame
nSame = 0
End If
Next
j = j + 1
arr2(j, 1) = Left$(arr1(i - 1, 1), 7)
arr2(j, 2) = nSame + 1
' in 1st & 2nd col to right by no. of uniques, adapt as required
Set rng = rng(1, 1).Offset(0, 1).Resize(j, 2)
rng.Columns(1).NumberFormat = "@" ' for those leading zeros
rng.Value = arr2
End Sub
Function BubbleSort2D(vArr)
Dim tmp As Variant
Dim i As Long
Dim bDone As Boolean
' sort first dimension of a 2D array
Do
bDone = True
For i = LBound(vArr) To UBound(vArr) - 1
If vArr(i, 1) vArr(i + 1, 1) Then
bDone = False
tmp = vArr(i, 1)
vArr(i, 1) = vArr(i + 1, 1)
vArr(i + 1, 1) = tmp
End If
Next i
Loop While Not bDone
End Function
Regards,
Peter T
"Sinner" wrote in message
....
Hi,
I have the following list.
08459087671
08459087673
08465228672
08429087671
08429087571
08454287667
08454287657
-----------------------------------
Would like to calculate the following i.e. the formula or VB code
should first list items based on first 7 characters uniqueness &
then
the quanity count.
Result:
-----------------------------------
Items Qty
0845908 2
0846522 1
0842908 2
0845428 2- Hide quoted text -
- Show quoted text -
Thanks Peter but its only giving 65536 in C1 of sheet 2.
Can you check pls.
-----------------------------------------
I think it's you that needs to check what you are doing!
Look at this line in the demo-
Set rng = ActiveSheet.Range("A1") ' < change to suit
Change A1 to the address of the first cell of your data
Alternatively, insert the following new line
Set rng = Selection ' insert this line just above arr1 = rng.Value
arr1 = rng.Value ' old line
Manually select the cells that contain your long text numbers and run
"Dups7"
Regards,
Peter T- Hide quoted text -
- Show quoted text -
Thankyou Peter.- Hide quoted text -
- Show quoted text -
Joel,
Can you further change it incase datewise table is required.
Thanks
----------------------------------------------------------------------
You have replied to me but you have addressed the question to Joel. Who are
you asking, Joel, myself, or both.
Personally I do not understand the question, maybe you could explain what
you mean. *Also clarify if the routine I posted did what you originally
asked for.
Regards,
Peter T- Hide quoted text -
- Show quoted text -
Dear Peter,
I did not check your code. I'll let you know about it.
Reply was to Joel.
If columnA of sheet1 are Dates & columnB is the list of numbers then
following is required:
It is same but now datewise and in table form with breakup.
---------------------------------------------------------------------------*---------------
Date: * * * * * * * 0845908 * * *0846522 * * *0842908 * * *0845428
02-mar-2008 * * * * 2 * * * * * * * * * * * * * * * * * *2
04-mar-2008 * * * * * * * * * * * * * *1
07-
mar-2008
2
---------------------------------------------------------------------------*---------------
Thx.- Hide quoted text -
- Show quoted text -
Joel??
|