Hi,

I am trying to write a macro that returns a unique list of values
based on the user's selection
(i.e. if the user's selection contained the following starting in cell
A1:

list
apples
apples
pears
pears
d
d
house
house
row

the macro would return
list
apples
pears
d
house
row

Problem is that the code does not work if the user selects blank rows
before the data begins.

Any suggestions on how to resize the selection to exclude the LEADING
blank rows?

My code is posted below. Just highlight a range of cells and run it.

Thanks
Tim

Sub Create_Unique_List()
'need to edit to verify first rows are not blank
'need to validate WS name


Dim wsht As Worksheet
Dim CurrentSheet As Worksheet
Dim myr As Range
Dim Sheetname As String


Set myr = Selection

'check for leading blank rows in selection
If myr.Cells(1, 1).Value = "" Then
MsgBox ("Unique filter will not work if the first row contains a
blank cell." _
& " Please reselect your data and re-run macro")
Exit Sub
End If


Set CurrentSheet = ActiveSheet

Set wsht = Sheets.Add

Sheetname = "Filtered List"

While Validate_New_Sheet_Name(Sheetname) < True
Sheetname = InputBox("The sheet " & Sheetname & " already exists.
" & _
" Please enter a new sheet name")
Wend

wsht.Name = Sheetname

CurrentSheet.Select

Selection.Copy

wsht.Select
Range("A1").Select
ActiveSheet.Paste


'find the last used column
LastColumnNumber = ActiveCell.SpecialCells(xlLastCell).Column + 1
If LastColumnNumber 26 Then
LastColumnLetter = Chr(Int((LastColumnNumber - 1) / 26) + 64) & _
Chr(((LastColumnNumber - 1) Mod 26) + 65)

Else
LastColumnLetter = Chr(LastColumnNumber + 64)
End If

Selection.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
LastColumnLetter & "1"), Unique:=True

'now delete the original data
LastColumnNumber = LastColumnNumber - 1
If LastColumnNumber 26 Then
LastColumnLetter = Chr(Int((LastColumnNumber - 1) / 26) + 64) & _
Chr(((LastColumnNumber - 1) Mod 26) + 65)

Else
LastColumnLetter = Chr(LastColumnNumber + 64)
End If

Range("a:" & LastColumnLetter).Delete


End Sub

Function Validate_New_Sheet_Name(NewSheetName As String) As Boolean

'first check to see if the sheet name is valid
If NewSheetName = "" Then
Validate_New_Sheet_Name = False
Exit Function
End If


'next check to see if already exists in workbook.
For i = 1 To Application.Worksheets.Count

'compare the NewSheetName to the current tab in the
workbook. If it agrees, the tab
' exists. Return false. Otherwise return true.
If StrConv(NewSheetName, vbProperCase) =
StrConv(Sheets(i).Name, vbProperCase) Then
'tab found. return false
Validate_New_Sheet_Name = False
Exit Function
End If

'check the length of the sheet name
If Len(NewSheetName) 31 Then
'new name too long. return false
Validate_New_Sheet_Name = False
Exit Function
End If

Next
'sheet name passed validations.
Validate_New_Sheet_Name = True

End Function