B
bruce taylor
This may be enough to get you started
Sub unique_values()
'Creates a sorted list of unique values starting at Target
'Rev A 27/5/2003
'PRELIMINARIES
Dim Examine As String, Target As String, ThisPrompt As
String, title As String
Dim UserRng_A As Range, UserRng_B As Range
Dim valu As Variant
'STEP 1 DETERMINE WHERE THE RAW DATA IS
ThisPrompt = "Where is the top of the VALUES to test ? eg
A3 or B5"
title = "UNIQUE VALUES (Rev A)"
On Error Resume Next ' in case a range does not get
selected
'The use of the "Set" statement assigns the output to the
selected ActiveCell
Set UserRng_A = Application.InputBox(prompt:=ThisPrompt,
title:=title, _
Default:=ActiveCell.Address, Type:=8) '"Type 8" means a
Range result.
If UserRng_A Is Nothing Then 'input was box cancelled
MsgBox "Cancelled"
Exit Sub ' Rev A
End If
'STEP 2 DETERMINE WHERE TO PUT THE LIST
ThisPrompt = "Where is the Data to be put ?" _
& Chr(13) & Chr(13) & "You will need blank cells under the
it."
Set UserRng_B = Application.InputBox(prompt:=ThisPrompt,
title:="Select a cell", _
Default:=ActiveCell.Address, Type:=8)
If UserRng_B Is Nothing Then
MsgBox "Cancelled"
Exit Sub ' Rev A
End If
Target = UserRng_B.Address() 'the address of the selected
cell
'STEP 3 GATHER BASIC DATA
Application.ScreenUpdating = False
UserRng_A(0, 1).Select 'select the cell above
Examine = Selection.Address() 'the address of the cell
above
valu = Selection.Formula 'store the contents of the cell
one row above the first data
UserRng_A(0, 1).Formula = "temporary string" 'THE ADVANCED
FILTER DEMANDS A STRING IN THIS CELL
'STEP 4 CREATE THE UNIQUE ENTRIES
Range(Target).Clear 'needed to stop filtering falling over
Range(Examine).Activate 'filter then insert unique values
starting at Target
Range(Examine, ActiveCell.End(xlDown)).AdvancedFilter
Action:=xlFilterCopy, _
CopyToRange:=Range(Target), Unique:=True
'now sort the values
Range(Target).Select 'musn't remove this line
Range(Target, ActiveCell.End(xlDown)).Select
Selection.Sort Key1:=Range(Target), Order1:=xlAscending,
Header:=xlYes, _
OrderCustom:=1
'STEP 5 TIDY UP
UserRng_B.Formula = ""
Range(Examine).Formula = valu 'restore the original entry
to this cell
Application.ScreenUpdating = True
End Sub
Sub unique_values()
'Creates a sorted list of unique values starting at Target
'Rev A 27/5/2003
'PRELIMINARIES
Dim Examine As String, Target As String, ThisPrompt As
String, title As String
Dim UserRng_A As Range, UserRng_B As Range
Dim valu As Variant
'STEP 1 DETERMINE WHERE THE RAW DATA IS
ThisPrompt = "Where is the top of the VALUES to test ? eg
A3 or B5"
title = "UNIQUE VALUES (Rev A)"
On Error Resume Next ' in case a range does not get
selected
'The use of the "Set" statement assigns the output to the
selected ActiveCell
Set UserRng_A = Application.InputBox(prompt:=ThisPrompt,
title:=title, _
Default:=ActiveCell.Address, Type:=8) '"Type 8" means a
Range result.
If UserRng_A Is Nothing Then 'input was box cancelled
MsgBox "Cancelled"
Exit Sub ' Rev A
End If
'STEP 2 DETERMINE WHERE TO PUT THE LIST
ThisPrompt = "Where is the Data to be put ?" _
& Chr(13) & Chr(13) & "You will need blank cells under the
it."
Set UserRng_B = Application.InputBox(prompt:=ThisPrompt,
title:="Select a cell", _
Default:=ActiveCell.Address, Type:=8)
If UserRng_B Is Nothing Then
MsgBox "Cancelled"
Exit Sub ' Rev A
End If
Target = UserRng_B.Address() 'the address of the selected
cell
'STEP 3 GATHER BASIC DATA
Application.ScreenUpdating = False
UserRng_A(0, 1).Select 'select the cell above
Examine = Selection.Address() 'the address of the cell
above
valu = Selection.Formula 'store the contents of the cell
one row above the first data
UserRng_A(0, 1).Formula = "temporary string" 'THE ADVANCED
FILTER DEMANDS A STRING IN THIS CELL
'STEP 4 CREATE THE UNIQUE ENTRIES
Range(Target).Clear 'needed to stop filtering falling over
Range(Examine).Activate 'filter then insert unique values
starting at Target
Range(Examine, ActiveCell.End(xlDown)).AdvancedFilter
Action:=xlFilterCopy, _
CopyToRange:=Range(Target), Unique:=True
'now sort the values
Range(Target).Select 'musn't remove this line
Range(Target, ActiveCell.End(xlDown)).Select
Selection.Sort Key1:=Range(Target), Order1:=xlAscending,
Header:=xlYes, _
OrderCustom:=1
'STEP 5 TIDY UP
UserRng_B.Formula = ""
Range(Examine).Formula = valu 'restore the original entry
to this cell
Application.ScreenUpdating = True
End Sub
-----Original Message-----
Hi! Can any one of you help me ?
I want to count the unique numbers in Cell A1:A4
I want to count the unique numbers in Cell B1:B4,C1:C4,D14 etc
Then I want count no of times the unique numbers from Cell A1:A4 have
been repeated against the unique numbers in Cell
B1:B4,C1:C4,D1
A B C D E
1 3 0 2
0 0 0 0 1
0 0 1 2 3
0 0 0 2 2
0 0 2 2 2
0 1 2 3 4
4 5 6 7 0
In E2:E6 will hold the results as example above.
I have try using the array formula =Sum(If (A1:A4=B1:B4)) ,with row1
against 2,3,4,5,6,7 but the answers were not correct always.
Thank you for your help.
------------------------------------------------
[/url]
~~ View and post usenet messages directly from http://www.ExcelForum.com/
.