unique values

  • Thread starter Thread starter scrabtree
  • Start date Start date
S

scrabtree

Hello. I have posted this question a couple times and
haven't got the answer I need yet. Past suggestions have
suggested using advanced filter, but that don't do what I
need.

I have a table in Sheet1 A1:Z100. I need, in Sheet2
Column A:A a list of all the unique values in Sheet1
A1:Z100 that are between the values of 1 and 1,000.

Please help!
 
scrabtree said:
Hello. I have posted this question a couple times and
haven't got the answer I need yet. Past suggestions have
suggested using advanced filter, but that don't do what I
need.

I have a table in Sheet1 A1:Z100. I need, in Sheet2
Column A:A a list of all the unique values in Sheet1
A1:Z100 that are between the values of 1 and 1,000.

Please help!

How about if you copy all the values in the table to Sheet 2 Column A, then
sort them and have a macro that deletes duplicates.
The net result will show all the unique values
 
Sub GetUnique()
Dim rng as Range, rng1 as Range
with Worksheets("Sheet2")
set rng = .Range("A1:A1000")
rng.Formula = "=row()"
rng.Formula = rng.Value
rng.offset(0,1).Formula = "=If(countif(Sheet1!A1:Z100,A1)>0,"""",na())"
On error Resume Next
set rng1 = rng.offset(0,1).SpecialCells(xlFormulas,xlErrors)
On Error goto 0
if not rng1 is nothing then
rng1.EntireRow.Delete
End if
.Columns(2).Delete
End With
End Sub
 
You are the best

-----Original Message-----
Sub GetUnique()
Dim rng as Range, rng1 as Range
with Worksheets("Sheet2")
set rng = .Range("A1:A1000")
rng.Formula = "=row()"
rng.Formula = rng.Value
rng.offset(0,1).Formula = "=If(countif(Sheet1!A1:Z100,A1)
0,"""",na())"
On error Resume Next
set rng1 = rng.offset(0,1).SpecialCells (xlFormulas,xlErrors)
On Error goto 0
if not rng1 is nothing then
rng1.EntireRow.Delete
End if
.Columns(2).Delete
End With
End Sub

--
Regards,
Tom Ogilvy






.
 
I spoke quick. I have tried this several times and it
don't work?
 
there is one modification that needs to be made. The formula needs abolute
references:

Sub GetUnique()
Dim rng As Range, rng1 As Range
With Worksheets("Sheet2")
Set rng = .Range("A1:A1000")
rng.Formula = "=row()"
rng.Formula = rng.Value
rng.Offset(0, 1).Formula = _
"=If(countif(Sheet1!$A$1:$Z$100,A1)>0,"""",na())"
On Error Resume Next
Set rng1 = rng.Offset(0, 1).SpecialCells(xlFormulas, xlErrors)
On Error GoTo 0
If Not rng1 Is Nothing Then
rng1.EntireRow.Delete
End If
.Columns(2).Delete
End With
End Sub

After that, it worked fine for me.

Even before that it produced some results, but in either case it would
depend on the data.
 
So you have 2600 cells, all filled with numbers? And you want to select the
unique numbers from this rectangular area?

Here's a macro that should suffice. If the range isn't what you described, fix
the line that begins with Const RangeRef


Sub GetNumbers()
Dim C As Long
Dim i As Variant
Dim N As Long
Dim Nums() As Double
Dim R As Long
Dim V As Variant
Dim X As Variant

Const RangeRef As String = "A1:Z100" '<<< FIX REFERENCE HERE IF NEEDED
V = Worksheets("Sheet1").Range(RangeRef).Value

ReDim Nums(1 To UBound(V, 1) * UBound(V, 2), 1 To 1)
N = 0

For R = 1 To UBound(V, 1)
For C = 1 To UBound(V, 2)
X = V(R, C)
If IsNumeric(X) Then
If X >= 1 And X <= 1000 Then
i = Application.Match(X, Nums(), 0)
If IsError(i) Then
N = N + 1
Nums(N, 1) = X
End If
End If
End If
Next C
Next R
Worksheets("Sheet2").Cells(1).Resize(N, 1).Value = Nums()

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top