Unique Entries

[John Phinney]

I need some assistance and didn't know where else to turn. I have this code that I got I think from google but it was some time ago. I have used it many different times and it works great. I know how to edit most of it to fit my needs, but I have come across a new challenge that I think this will work for, but I am not sure how to set it up. Here is the code I have

Dim uniq As New Collectio
For Each ce In Range("J2", Range("J65536").End(xlUp)
On Error Resume Nex
uniq.Add Item:=ce.Value, key:=CStr(ce.Value
Next c
Range("K1").Selec
For Each ce In uni
ActiveCell.Value = c
ActiveCell.Offset(1, 0).Selec
Next c

This works on whatever the active sheet is. It finds all the unique entries in column J and puts them into column K starting in row one on the same page. What I need is a way to have it look in column J on ALL WORKSHEETS in a workbook (not knowing how many there will be each time), find the unique entries, and put them on a worksheet in A DIFFERENT WORKBOOK

I think to get them into another workbook, I just need to put in to activate a new workbook and worksheet right before the line: Range("K1").Select, that much I know how to do. I know excel and VBA fairly well, but as to how to set the range to look at all worksheets, I am lost

Any help would be greatly appreciated, I think this should be able to work, I just don't know how to do it, and I can't find anything in google that seems to make sense, at least to me

Thanks

John Phinney

 

[Bob Phillips]

Hi John,

Give this a try

Dim uniq As New Collection
Dim sh As Worksheet
Dim oWb As Workbook
Dim iTarget As Long

Set oWb = Workbooks.Add
For Each sh In ActiveWorkbook
For Each ce In Range("J2", Range("J" & Rows.Count).End(xlUp))
On Error Resume Next
uniq.Add Item:=ce.Value, key:=CStr(ce.Value)
Next ce
For Each ce In uniq
oWb.Worksheets(1).Range("K1").Offset(iTarget, 0).Value = ce
iTarget = iTarget + 1
Next ce
Next sh

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

I need some assistance and didn't know where else to turn. I have this

code that I got I think from google but it was some time ago. I have used
it many different times and it works great. I know how to edit most of it
to fit my needs, but I have come across a new challenge that I think this
will work for, but I am not sure how to set it up. Here is the code I have.

Dim uniq As New Collection
For Each ce In Range("J2", Range("J65536").End(xlUp))
On Error Resume Next
uniq.Add Item:=ce.Value, key:=CStr(ce.Value)
Next ce
Range("K1").Select
For Each ce In uniq
ActiveCell.Value = ce
ActiveCell.Offset(1, 0).Select
Next ce

This works on whatever the active sheet is. It finds all the unique

entries in column J and puts them into column K starting in row one on the
same page. What I need is a way to have it look in column J on ALL
WORKSHEETS in a workbook (not knowing how many there will be each time),
find the unique entries, and put them on a worksheet in A DIFFERENT
WORKBOOK.

I think to get them into another workbook, I just need to put in to

activate a new workbook and worksheet right before the line:
Range("K1").Select, that much I know how to do. I know excel and VBA
fairly well, but as to how to set the range to look at all worksheets, I am
lost.

Any help would be greatly appreciated, I think this should be able to

work, I just don't know how to do it, and I can't find anything in google
that seems to make sense, at least to me.

 

[Bob Phillips]

Sorry, that should be

For Each sh in ActiveWorkbook.Worksheets

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

The code seems to lock up on:

For Each sh in ActiveWorkbook

It is telling me:

Object Doesn't Support This Property Or Method

I don't know if this would be a problem. But sometimes the workbook will

only have one worksheet, sometimes it will have more. The workbook is a
consolidation of several others and it just depends on how much data there
is. I don't know if that makes a difference. I think I understand what you
have here, but it doesn't seem to work.

 

[Dave Peterson]

And I modified Bob's code slightly:

Option Explicit
Sub testme()

Dim uniq As New Collection
Dim sh As Worksheet
Dim oWb As Workbook
Dim origWkbk As Workbook
Dim iCtr As Long
Dim ce As Range

Set origWkbk = ActiveWorkbook

Set oWb = Workbooks.Add
On Error Resume Next
For Each sh In origWkbk.Worksheets
With sh
For Each ce In .Range("J2", .Range("J" & Rows.Count).End(xlUp))
uniq.Add Item:=ce.Value, key:=CStr(ce.Value)
Next ce
End With
Next sh
On Error GoTo 0

For iCtr = 1 To uniq.Count
oWb.Worksheets(1).Range("K1").Offset(iCtr - 1, 0).Value =
uniq.Item(iCtr)
Next iCtr

End Sub