From: Steve on
I having difficulty with unigue filtering. Probably because it's too close to
tommorrow.

I have a range of numbers in a column. There may be up to a hundred rows.
I want to copy only the unique numbers to another column on another tab.
Is that possible ?

599
478
478
478
478
982
982
785
894

Thanks,

Steve

From: Teethless mama on
Try Advanced Filter


"Steve" wrote:

> I having difficulty with unigue filtering. Probably because it's too close to
> tommorrow.
>
> I have a range of numbers in a column. There may be up to a hundred rows.
> I want to copy only the unique numbers to another column on another tab.
> Is that possible ?
>
> 599
> 478
> 478
> 478
> 478
> 982
> 982
> 785
> 894
>
> Thanks,
>
> Steve
>
From: Gary Brown on
Here's something I put together some time ago....

'/==========================================/
Sub UniqueValues_List()
Dim dblLastRow As Double
Dim lCol As Integer, iCheckError As Integer
Dim lRow As Long, i As Long
Dim nName As name
Dim rngRange As Range
Dim strResultsTableName As String
Dim strWkbk As String
Dim strWksht As String
Dim strRange As String
Dim wkb As Workbook
Dim wkb_New As Workbook
Dim WS As Worksheet

On Error GoTo err_UniqueValues_List

strResultsTableName = "Unique_Values"
iCheckError = 0

Set rngRange = _
Application.InputBox(Prompt:="Select Range to be Searched: " & _
vbCr & vbCr & "Only ranges in CURRENT WORKSHEET may be selected", _
Title:="Range Selection...", _
Default:=Application.Selection.Address, Type:=8)

strRange = "Range: " & rngRange.Address
strWkbk = "Workbook: " & ActiveWorkbook.FullName
strWksht = "Worksheet: " & ActiveSheet.name

If Len(rngRange.Address) = 0 Then
MsgBox "No Cells were selected." & vbLf & vbLf & _
"Process Aborted.....", vbExclamation + vbOKOnly, "WARNING....."
Exit Sub
Else
rngRange.Select
End If

rngRange.Select

Set WS = ActiveSheet
Set wkb = ActiveWorkbook

'check for multiple range selections
If Selection.Areas.Count > 1 Then
MsgBox "Multiple Range selections are not supported.", _
vbExclamation + vbOKOnly, "Warning..."
End If

'check for too many cells
' because the selection will be copied to a new worksheet and
' the current version of Excel (XP) only has 65536 rows
If Selection.Cells.Count > 65536 Then
MsgBox "Sorry, your selection is to large to count unique values.", _
vbExclamation + vbOKOnly, "Warning..."
GoTo exit_UniqueValues_List
End If

If Selection.Cells.Count = 1 Then
MsgBox "You have not selected a range of cells.", _
vbExclamation + vbOKOnly, "Warning..."
GoTo exit_UniqueValues_List
End If

'Application.ScreenUpdating = False

Selection.Copy
Workbooks.Add
Sheets.Add
Sheets(1).Cells(1).PasteSpecial xlValues
lCol = Cells(1).CurrentRegion.Columns.Count
lRow = Cells(1).CurrentRegion.Rows.Count


If lCol > 1 Then
For i = 2 To lCol
Range(Cells(1, i), Cells(lRow, i)).Copy
Cells((lRow * (i - 1)) + 1, 1).PasteSpecial xlPasteValues
Range(Cells(1, i), Cells(lRow, i)).ClearContents
Next
End If

Rows("65536:65536").Delete Shift:=xlUp

ActiveSheet.UsedRange.Select

If ActiveSheet.UsedRange.Count = 1 Then
If ActiveWorkbook.name <> wkb.name Then
ActiveWorkbook.Close False
End If
wkb.Activate
MsgBox "Only Blank cells have been selected." & vbCr & _
"Process Stopped.", vbInformation + vbOKOnly, "Warning..."
GoTo exit_UniqueValues_List
End If

Selection.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"B1"), Unique:=True
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.Insert Shift:=xlDown

Range("A1").Select
ActiveCell.FormulaR1C1 = "Unique Values"
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle
Columns("A:A").EntireColumn.AutoFit
Range("A2").Select
ActiveWindow.FreezePanes = True

Range("A1").Select

ActiveSheet.Select
ActiveWorkbook.ActiveSheet.name = strResultsTableName

Set wkb_New = ActiveWorkbook

dblLastRow = _
ActiveSheet.Cells.SpecialCells(xlLastCell).Row - 1

Range("A3:A" & dblLastRow).Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, HEADER:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

ActiveSheet.Copy after:=Workbooks(wkb.name).Sheets(WS.name)
strResultsTableName = ActiveSheet.name
Range("A1").Select
wkb_New.Activate

wkb.Activate

On Error Resume Next
'delete 'Extract' name
For Each nName In Names
If IsError(Application.WorksheetFunction.Search("Extract", _
nName.name)) Then
Else
ActiveWorkbook.Names(nName.name).Delete
End If
Next nName

On Error GoTo err_UniqueValues_List

Call MakeComment(strWkbk, strWksht, strRange)

Range("A1").Comment.Shape.Select True
Selection.ShapeRange.IncrementLeft 150
Selection.ShapeRange.IncrementTop 10


exit_UniqueValues_List:
iCheckError = 1

wkb_New.Activate

If ActiveWorkbook.name <> wkb.name Then
ActiveWorkbook.Close False
End If

wkb.Activate

'Application.ScreenUpdating = True

Set rngRange = Nothing
Set wkb = Nothing
Set wkb_New = Nothing
Set WS = Nothing

Application.Worksheets(strResultsTableName).Activate

Range("A1").Select

Application.Dialogs(xlDialogWorkbookName).Show

Exit Sub

err_UniqueValues_List:

If iCheckError = 1 Then
Exit Sub
End If

If Err.Number = 1004 Then 'Select method of Range class failed
Set wkb = ActiveWorkbook
End If

MsgBox "Selected Range(s) could not be processed." & vbCr & _
"Please try again..." & vbCr & vbCr & _
"Did you select a range that was NOT on the Current Worksheet?", _
vbCritical + vbOKOnly, "Warning..."

Resume exit_UniqueValues_List

End Sub
'/========================================/
Private Sub MakeComment(strWorkbook, strWorksheet, strRng)
'create comment
Dim dblLastRow As Double

dblLastRow = _
ActiveSheet.Cells.SpecialCells(xlLastCell).Row - 1

Range("A1").AddComment

With Range("A1").Comment
.Visible = False

.Text Text:= _
"Unique Values Count:" & dblLastRow & Chr(10) & _
strWorkbook & Chr(10) & _
strWorksheet & Chr(10) & _
strRng

.Shape.ScaleHeight 1.75, msoFalse, msoScaleFromTopLeft
.Shape.ScaleWidth 2, msoFalse, msoScaleFromTopLeft

.Visible = True
End With

End Sub
'/=============================================/


--
Hope this helps.
If it does, please click the Yes button.
Thanks in advance for your feedback.
Gary Brown



"Steve" wrote:

> I having difficulty with unigue filtering. Probably because it's too close to
> tommorrow.
>
> I have a range of numbers in a column. There may be up to a hundred rows.
> I want to copy only the unique numbers to another column on another tab.
> Is that possible ?
>
> 599
> 478
> 478
> 478
> 478
> 982
> 982
> 785
> 894
>
> Thanks,
>
> Steve
>
From: T. Valko on
>I want to copy only the unique numbers to
>another column on another tab.

Let's assume the data to filter is on sheet1 and you want the data extracted
to sheet2 starting in cell A1.

Navigate to sheet2 cell A1 *then* start the filter process.

Data>Filter>Advanced filter

--
Biff
Microsoft Excel MVP


"Steve" <Steve(a)discussions.microsoft.com> wrote in message
news:D9611C3C-FC5C-4991-A610-A85C2BC053DE(a)microsoft.com...
>I having difficulty with unigue filtering. Probably because it's too close
>to
> tommorrow.
>
> I have a range of numbers in a column. There may be up to a hundred rows.
> I want to copy only the unique numbers to another column on another tab.
> Is that possible ?
>
> 599
> 478
> 478
> 478
> 478
> 982
> 982
> 785
> 894
>
> Thanks,
>
> Steve
>


From: Steve on
Thank you. That was it. I was starting on sheet A.

Thanks again,

Steve

"T. Valko" wrote:

> >I want to copy only the unique numbers to
> >another column on another tab.
>
> Let's assume the data to filter is on sheet1 and you want the data extracted
> to sheet2 starting in cell A1.
>
> Navigate to sheet2 cell A1 *then* start the filter process.
>
> Data>Filter>Advanced filter
>
> --
> Biff
> Microsoft Excel MVP
>
>
> "Steve" <Steve(a)discussions.microsoft.com> wrote in message
> news:D9611C3C-FC5C-4991-A610-A85C2BC053DE(a)microsoft.com...
> >I having difficulty with unigue filtering. Probably because it's too close
> >to
> > tommorrow.
> >
> > I have a range of numbers in a column. There may be up to a hundred rows.
> > I want to copy only the unique numbers to another column on another tab.
> > Is that possible ?
> >
> > 599
> > 478
> > 478
> > 478
> > 478
> > 982
> > 982
> > 785
> > 894
> >
> > Thanks,
> >
> > Steve
> >
>
>
> .
>