Code suggestions or criticisms

[rob.barnes01]

Hello all,

We're constantly filtering unique values from our data files. As such, I've been asked to create a macro which will simplify the unique values filter, making it faster and simpler to use for the less tech-savvy within our company.

Below is what I've come up with, but before I present it to the men upstairs, I'd very much appreciate any suggestions for improvement.

Option Explicit

Sub CopyUniqueValues()
Dim Rng As Range
Dim ws As Worksheet

'Prompt user to select a range
On Error Resume Next
Set Rng = Application.InputBox(prompt:="Please select the range of cells you'd like to filter:", Type:=8)
If Rng Is Nothing Then Exit Sub

Application.ScreenUpdating = False

'Validate user selection
If TypeName(Rng) <> "Range" Then
    Beep
    MsgBox "You must select a range of values first.", vbExclamation + vbOKOnly, "Select a Range"
    Exit Sub
ElseIf Rng.Areas.Count > 1 Then
    Beep
    MsgBox "Multiple selections are not permitted.", vbExclamation + vbOKOnly, "Invalid Selection"
    Exit Sub
ElseIf Rng.Count < 3 Then
    Beep
    MsgBox "You must select a range containing a label and at least two unique values", vbExclamation + vbOKOnly, "Invalid Selection"
    Exit Sub
End If

'If UNIQUEVALUES sheet exists, delete it
Application.DisplayAlerts = False
On Error Resume Next
Sheets("UNIQUEVALUES").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Create UNIQUEVALUES sheet, paste selected range and filter unique values
    Set ws = ActiveSheet
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "UNIQUEVALUES"
    ws.Range(Rng.Address).Copy Sheets("UNIQUEVALUES").Range("A1")
    Cells.Select
    Selection.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "AZ1"), Unique:=True
    Columns("A:AY").Delete Shift:=xlToLeft
    Range("A1").Select
    
Application.ScreenUpdating = True
 
End Sub

Thanks, all, and have a great weekend!

Rob

UPDATE: Added a line of code to turn alerts back on. Didn't notice that one until I closed Excel and my personal macro workbook didn't save.

 

[BlueHornet]

I like it.

How about trying to guess and select a range as a default, say if the user simply has the cursor in the middle of a starting range, pick that and suggest it:

Sub CopyUniqueValues()
Dim Rng As Range
Dim Rng0 As String
Dim ws As Worksheet
Dim TopLeft, BottomRight As String

[COLOR="Green"]'Prompt user to select a range[/COLOR]
On Error Resume Next
[COLOR="Green"]'First try to guess the range as a default[/COLOR]
TopLeft = ActiveCell.End(xlUp).End(xlToLeft).Address
BottomRight = ActiveCell.End(xlDown).End(xlToRight).Address
Rng0 = TopLeft & ":" & BottomRight
[COLOR="Green"]'Use the selected range values as "first guess" default[/COLOR]
Set Rng = Application.InputBox(prompt:="Please select the range of cells you'd like to filter:", Default:=Rng0, Title:="Selection Dialog", Type:=8)
If Rng Is Nothing Then Exit Sub

 

[rob.barnes01]

Thanks for the suggestion, Hornet!