Unique filtering to another sheet ?
in [Functions]
|
From: Steve on 31 Mar 2010 16:10 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 31 Mar 2010 16:42 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 31 Mar 2010 16:44 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 31 Mar 2010 16:57 >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 1 Apr 2010 13:49 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 > > > > > . >
|
Next
|
Last
Pages: 1 2 Prev: IF formula not working Next: Remove Last x Character(s) in Selected Cells |