unique entries code
 

I tried the following code several times and it didn't
work???


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



"scrabtree" wrote in
message
...
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!

unique entries code
 

This code (from the J-Walk site) does almost what I want
but adds the unique entries to a list box. If I could get
the unique entries in Sheet2 Column A:A I would be cooking:
Option Explicit
' This example is based on a tip by J.G. Hussey,
' published in "Visual Basic Programmer's Journal"

Sub RemoveDuplicates()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item

' The items are in A1:A105
Set AllCells = Range("A1:B105")

' The next statement ignores the error caused
' by attempting to add a duplicate key to the collection.
' The duplicate is not added - which is just what we
want!
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Cell.Value, CStr(Cell.Value)
' Note: the 2nd argument (key) for the Add method
must be a string
Next Cell

' Resume normal error handling
On Error GoTo 0

' Sort the collection (optional)
For i = 1 To NoDupes.Count - 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, befo=j
NoDupes.Add Swap2, befo=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i

' Add the sorted, non-duplicated items to a ListBox
For Each Item In NoDupes
UserForm1.ListBox1.AddItem Item
Next Item

' Show the UserForm
UserForm1.Show
End Sub




-----Original Message-----
I tried the following code several times and it didn't
work???


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



"scrabtree" wrote
in
message
...
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!

.

unique entries code
 

I just saw the post in my earlier string, thanks.

-----Original Message-----
I tried the following code several times and it didn't
work???


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



"scrabtree" wrote
in
message
...
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!

.

unique entries code
 

I provided a slight revision of my original code, which works for me based
on your description.

--
Regards,
Tom Ogilvy

"scrabtree" wrote in message
...
This code (from the J-Walk site) does almost what I want
but adds the unique entries to a list box. If I could get
the unique entries in Sheet2 Column A:A I would be cooking:
Option Explicit
' This example is based on a tip by J.G. Hussey,
' published in "Visual Basic Programmer's Journal"

Sub RemoveDuplicates()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item

' The items are in A1:A105
Set AllCells = Range("A1:B105")

' The next statement ignores the error caused
' by attempting to add a duplicate key to the collection.
' The duplicate is not added - which is just what we
want!
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Cell.Value, CStr(Cell.Value)
' Note: the 2nd argument (key) for the Add method
must be a string
Next Cell

' Resume normal error handling
On Error GoTo 0

' Sort the collection (optional)
For i = 1 To NoDupes.Count - 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, befo=j
NoDupes.Add Swap2, befo=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i

' Add the sorted, non-duplicated items to a ListBox
For Each Item In NoDupes
UserForm1.ListBox1.AddItem Item
Next Item

' Show the UserForm
UserForm1.Show
End Sub




-----Original Message-----
I tried the following code several times and it didn't
work???


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



"scrabtree" wrote
in
message
...
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!

.

unique entries code
 

As always, thanks for your help. I'm not sure I
understand how it works, but I see that changing A1:A1000
to A1:A500, changes the upper value it searches for. I
can also change the table range to any option I want.
This will work great.


-----Original Message-----
I provided a slight revision of my original code, which
works for me based
on your description.

--
Regards,
Tom Ogilvy

"scrabtree" wrote
in message
...
This code (from the J-Walk site) does almost what I want
but adds the unique entries to a list box. If I could
get
the unique entries in Sheet2 Column A:A I would be
cooking:
Option Explicit
' This example is based on a tip by J.G. Hussey,
' published in "Visual Basic Programmer's Journal"

Sub RemoveDuplicates()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item

' The items are in A1:A105
Set AllCells = Range("A1:B105")

' The next statement ignores the error caused
' by attempting to add a duplicate key to the
collection.
' The duplicate is not added - which is just what we
want!
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Cell.Value, CStr(Cell.Value)
' Note: the 2nd argument (key) for the Add method
must be a string
Next Cell

' Resume normal error handling
On Error GoTo 0

' Sort the collection (optional)
For i = 1 To NoDupes.Count - 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, befo=j
NoDupes.Add Swap2, befo=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i

' Add the sorted, non-duplicated items to a ListBox
For Each Item In NoDupes
UserForm1.ListBox1.AddItem Item
Next Item

' Show the UserForm
UserForm1.Show
End Sub




-----Original Message-----
I tried the following code several times and it didn't
work???


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



"scrabtree" wrote
in
message
...
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!

.



.