Macro to find and record Unique values?

[Arlen]

I have quite literally hundreds of worksheets where I need to filter out the
unique numbers in Column C, and paste them into a single new filtered list in
a new workbook.

I recorded a Macro and it looks like this:

Columns("C:C").Select
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$C:$C"), , xlYes).Name =
"List1"
Columns("C:C").Select
Columns("C:C").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Selection.Copy
With ActiveWindow
.Top = 1.75
.Left = -389
End With
Windows("Book3").Activate
ActiveSheet.Paste
End Sub


This needs a few tweaks, but I don't know VBA.
How do I copy only the numbers once the filter has been applied. So
something like Selection.Copy(NumbersOnlyPlease) ?
Then, how do I paste those numbers consecutively down Column 1 in Book3 so
that the first group occupies, say A1-A8, then the next occupies A9-A25,
perhaps.

Thanks for your help.

Arlen

 

[Bernie Deitrick]

Arlen,

Not sure why the first group would occupy 8 rows, and the next group 17 rows. This code will copy
the unique number values from the activesheet's column C to a new workbook, with 6 sets of the
numbers in column A. I' ve also assumed that the numbers are constants, not the returned value from
functions.

Sub TryNow()
Dim myB As Workbook
Dim mySh As Worksheet
Dim i As Integer
Dim myCopies As Integer
myCopies = 6

Set mySh = ActiveSheet
With Range("C:C")
.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants, 1).Copy
Set myB = Workbooks.Add
myB.Sheets(1).Cells(1, 1).PasteSpecial
For i = 2 To myCopies
myB.Sheets(1).Cells(Rows.Count, 1).End(xlUp)(2).PasteSpecial
Next i
ThisWorkbook.Activate
mySh.ShowAllData
End With

End Sub

HTH,
Bernie
MS Excel MVP

 

[Don Guillett]

try this

'does one worksheet to another workbook.You need to define the sheet also.
Sub dounique()mc = "c"
slr = Cells(Rows.Count, mc).End(xlUp).row
dlr = Workbooks("destfilename.xls").Sheets("sheet2").Cells(Rows.Count,
"K").End(xlUp).row + 1
MsgBox dlr
Range(Cells(1, mc), Cells(slr, mc)). _
AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Range(Cells(2, mc), Cells(slr, mc)).Copy
Workbooks("destfilename.xls").Sheets("sheet2").Cells(dlr, "k")
ActiveSheet.ShowAllData
End Sub

'for all worksheets in the source workbook, NOT tested
Sub dounique()mc = "c"
for each ws in worksheets
slr = ws.Cells(Rows.Count, mc).End(xlUp).row
dlr = Workbooks("destfilename.xls").Sheets("sheet2").Cells(Rows.Count,
"K").End(xlUp).row + 1
'MsgBox dlr
ws.Range(Cells(1, mc), Cells(slr, mc)). _
AdvancedFilter Action:=xlFilterInPlace, Unique:=True
ws.Range(Cells(2, mc), Cells(slr, mc)).Copy
Workbooks("destfilename.xls").Sheets("sheet2").Cells(dlr, "k")
ws.ShowAllData
next ws
End Sub

 

[Arlen]

Bernie:
Your macro is moving everything fine, but what I meant by different numbers
of rows is simply this: say you end up with 5 unique values in Book1, Col C
-- that shows up in A1-A5 of the new sheet as:
34
53
90
197
8


Then, you move to Book 2, Col C, it has 3 unique values within itself,
53
700
8

It should then tack these onto the new list in A6-A8, but really, it should
only tack on 700, since the other numbers are already used.

And THEN, dare to dream, it could crawl through all the spreadsheets in a
folder automatically, and when all values have been pulled and the unique
list is compiled, it sorts the result A->Z.

Is that possible?

Arlen

 

[Don Guillett]

Did you try mine?

 

[Arlen]

Don,

I tried yours, but I got a lot of red. Some of the codelines got broken I
think, but it's having problems with the initial Sub line

Sub dounique()mc = "c"

Is that supposed to be:

Sub dounique()
mc = "c"

And again, the line

Workbooks("destfilename.xls").Sheets("sheet2").Cells(dlr, "k")

is in red. I just don't know anything about VBA to know what the problem is.

Could you explain a bit how your code works?

Thank you.

Arlen

 

[Arlen]

Don,

I did try yours. The following lines were red in the Step Into Macro screen.

Sub dounique()mc = "c"

dlr = Workbooks("destfilename.xls").Sheets("sheet2").Cells(Rows.Count,
"K").End(xlUp).row + 1

Workbooks("destfilename.xls").Sheets("sheet2").Cells(dlr, "k")

I just don't know enough of VBA to know what is happening here.

Could you explain a bit about what your code does?

Thanks,

Arlen

 

[Don Guillett]

The red indicates wordwrap. The mc="c" is on a separate line. then change
the c to suit your column which was c...
Then correct other wordwrap problems by going to

dlr = Workbooks("destfilename.xls").Sheets("sheet2").Cells(Rows.Count,
and use the delete key to bring up so all is on ONE line. Of course, change
the filename to suit.

"K").End(xlUp).row + 1

If you're new to macros, you may want to read David McRitchie's intro
at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm