List of unique entries in range

[Steve E]

Hi,

In XL2003.
I have a range of cells (M18:M32) that can have as many as 15 different
entries and on the same worksheet I am trying to list the unique entries
(normally 3 - 4 are actually unique within that range). I want the list of
unique entries to update itself whenever an entry is made into the range.
I'm trying a Worksheet_SelectionChange event as follows using some code that
I found by Ron Coderre in the group posted about a year ago...:

Option Explicit
Sub Worksheet_SelectionChange(ByVal Target As Range) 'ExtractUnique()
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Me.Range("M18:M32"), .Cells) Is Nothing Then
Application.EnableEvents = False
Me.Unprotect (PWORD_Worksheet)
Me.Range("M18:M32").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("M36"), Unique:=True
Me.Protect (PWORD_Worksheet)
Application.EnableEvents = True
End If
End With
End Sub

I want to use the results in this list as criteria for a VLOOKUP function if
there is an entry in M36...

When I make a change in my range... nothing happens...

Can anyone tell me what I've gotten wrong?

TIA,

SteveE

 

[Dave Peterson]

I would think you'd want to use the worksheet_change event. (You can change a
cell without changing the selection.)

Remember that Advanced Filter expects headers in the List range (m18 is the
header??) and will put that same header in the "copy to" range.

 

[Steve E]

Hi Dave,

OK. Clearly had the wrong event.

I already have a few worksheet_change events and have trouble figuring out
where or how to add another...

I adjusted my range to include the header (it's two merged cells...) and
expanded the copy to range so that there is room for the header there too...
here's what I've tried but get no results:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Me.Range("C18:X32,C37:H43"), .Cells) Is Nothing Then

Dim N As Long
Dim rng As Excel.Range
Set rng = Me.Range("O18:O32")

Application.EnableEvents = False
Me.Unprotect (PWORD_Worksheet)
With Me.Range("E1")
.NumberFormat = "dd mmm yyyy hh:mm:ss"
.Value = Now
End With

If Not Intersect(Me.Range("M18:M32"), .Cells) Is Nothing Then
Me.Range("M16:M32").AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=Range("M35"), Unique:=True
End If

For N = 1 To rng.Count
If rng(N).Value = "Railroaded" Then
Me.Range("P:S").EntireColumn.Hidden = False
Exit For
End If
Next


Me.Protect (PWORD_Worksheet)
Application.EnableEvents = True
End If
End With
End Sub

As you can see, I'm trying to record the time the overall range was last
changed and unhiding several columns when a 'magic word' is entered in one
range (still trying to figure out how to change that part so that they
re-hide themselves if that word isn't in that range...) and now I'm trying to
get this part...

Ideas?

TIA,

Steve E

 

[Dave Peterson]

So it looks like you're getting a unique list just to make your loop go a bit
faster? If that's true, you could use application.countif() to see if the value
is in that range.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim N As Long
Dim PWORD_Worksheet As String
Dim rng As Range

PWORD_Worksheet = "hi"

With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Me.Range("C18:X32,C37:H43"), .Cells) Is Nothing Then

Application.EnableEvents = False
Me.Unprotect PWORD_Worksheet
With Me.Range("E1")
.NumberFormat = "dd mmm yyyy hh:mm:ss"
.Value = Now
End With

Set rng = Me.Range("M18:M32")
If Not Intersect(rng, .Cells) Is Nothing Then
If Application.CountIf(rng, "railroaded") > 0 Then
Me.Range("P:S").EntireColumn.Hidden = False
Else
'maybe????
Me.Range("P:s").EntireColumn.Hidden = True
End If
End If

Me.Protect PWORD_Worksheet
Application.EnableEvents = True
End If
End With
End Sub


You could use application.match instead of this, too:
If Application.CountIf(rng, "railroaded") > 0 Then
could be:
If isnumeric(Application.match("railroad", rng, 0)) then