I have searched through and through and have not found an answer to
this riddle. I have a complicated worksheet which allows the user to
enter a series of numbers in column A. Without them having to stop and
run the advance filter option, I need to put in a code that will
extract unique values from column A (A6:A1000) to column B (B6:B1000).
I'm thinking insert a code in worksheet if possible, however a looped
macro may do the trick. I just dont want the user having to do anything
but insert their list of values. Someone please help.

Range("A6:A1000").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("B6:B1000"), Unique:=True

--
HTH,
Gary Brown

If this post was helpful to you, please select ''YES'' at the bottom of the
post.



"J.W. Aldridge" wrote:

I have searched through and through and have not found an answer to
this riddle. I have a complicated worksheet which allows the user to
enter a series of numbers in column A. Without them having to stop and
run the advance filter option, I need to put in a code that will
extract unique values from column A (A6:A1000) to column B (B6:B1000).
I'm thinking insert a code in worksheet if possible, however a looped
macro may do the trick. I just dont want the user having to do anything
but insert their list of values. Someone please help.

JW,

I assume you mean that if the value entered in column A does not appear in column B, copy it to the
bottom of column B.....

You could use the change event: copy the first section of code below, right click on the sheet tab,
select "view Code" and paste the code in the window that appears.

Or if you only want to copy newly entered values, use the second version...

HTH,
Bernie
MS Excel MVP

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count 1 Then Exit Sub
If Target.Column < 1 Then Exit Sub
If Application.CountIf(Range("B:B"), Target.Value) = 0 Then
Application.EnableEvents = False
Range("B65536").End(xlUp)(2).Value = Target.Value
Application.EnableEvents = True
End If
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count 1 Then Exit Sub
If Target.Column < 1 Then Exit Sub
If Application.CountIf(Range("A6",Target(0)), Target.Value) = 0 Then
Application.EnableEvents = False
Range("B65536").End(xlUp)(2).Value = Target.Value
Application.EnableEvents = True
End If
End Sub


"J.W. Aldridge" wrote in message
oups.com...
I have searched through and through and have not found an answer to
this riddle. I have a complicated worksheet which allows the user to
enter a series of numbers in column A. Without them having to stop and
run the advance filter option, I need to put in a code that will
extract unique values from column A (A6:A1000) to column B (B6:B1000).
I'm thinking insert a code in worksheet if possible, however a looped
macro may do the trick. I just dont want the user having to do anything
but insert their list of values. Someone please help.

GB,

I'm not quite sure where to put that code.... Is it part of a larger
code? And not sure where to place it. (worksheet or macro). I am
learning VB quickly but the simple instructions still get me as of now.


Thanx.

Bernie.
The second one was close. But not quite what I am looking for.
As the user types their values/list in column a, Column B needs to
reflect a filtered replica simultaneuosly. So if A6 starts off with a
list.... Starting with B6, a list will also be created with only the
unique values.

There will never be values in column A unless the user inputs them.

Hope this is a little clearer (and possible).

Thanx.

DIsregaurd that.... I got the first code to work fine. The only thing
is, if they make a typo, the extracted value remains in column B. I
guess I need it to loop if possible and somehow continue to look at row
A to find the unique values.

Thanx

JW,

Use this:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRow As Long
If Target.Cells.Count 1 Then Exit Sub
If Target.Column < 1 Then Exit Sub

Application.EnableEvents = False
If Application.CountIf(Range("B:B"), Target.Value) = 0 Then
Range("B65536").End(xlUp)(2).Value = Target.Value
End If

For myRow = Range("B65536").End(xlUp).Row To 2 Step -1
If IsError(Application.Match(Cells(myRow, 2).Value, Range("A:A"), False)) Then
Cells(myRow, 2).Delete
End If
Next myRow

Application.EnableEvents = True

HTH,
Bernie
MS Excel MVP


"J.W. Aldridge" wrote in message
ups.com...

DIsregaurd that.... I got the first code to work fine. The only thing
is, if they make a typo, the extracted value remains in column B. I
guess I need it to loop if possible and somehow continue to look at row
A to find the unique values.

Thanx

I got the code above to work. However I am having problems changing the
code to fit my cell criteria/range. I've played around with this one
for quite some time, and the places that I would normally make changes
to the range doesn't seem to work.

Instead of A:A to B:B. .....I need this code to reflect B12:B3000 to
L12:L3000


Thanx.


Reposting code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRow As Long
If Target.Cells.Count 1 Then Exit Sub
If Target.Column < 1 Then Exit Sub


Application.EnableEvents = False
If Application.CountIf(Range("B:B"), Target.Value) = 0 Then
Range("B65536").End(xlUp)(2).Value = Target.Value
End If


For myRow = Range("B65536").End(xlUp).Row To 2 Step -1
If IsError(Application.Match(Cells(myRow, 2).Value, Range("A:A"),
False)) Then
Cells(myRow, 2).ClearContents
End If

Next myRow


Application.EnableEvents = True

End Sub