select a range through last cell question
 

I have a question about the following code:

Option Explicit
Public Sub UniqueValues()

'Searches target range and returns unique values to desired column

Dim Col As Collection
Dim Arr() As Variant
Dim rCell As Range
Dim rng As Range
Dim i As Long
Dim WB As Workbook
Dim sh1 As Worksheet
Dim ShUnVa As Worksheet

Set WB = ActiveWorkbook
Set sh1 = WB.Sheets("Sheet1")
Set ShUnVa = WB.Sheets("UniqueValues")
Set Col = New Collection
Set rng = sh1.Range("F2:GI32")


ShUnVa.Select
ShUnVa.Columns("A:A").Delete Shift:=xlToLeft


For Each rCell In rng.Cells
If Not IsEmpty(rCell.Value) Then
On Error Resume Next
Col.Add rCell.Value, CStr(rCell.Value)
On Error GoTo 0
End If
Next rCell
On Error Resume Next
ReDim Arr(1 To Col.Count)

For i = LBound(Arr, 1) To UBound(Arr, 1)
Arr(i) = Col.Item(i)
Next i

ShUnVa.Range("A1").Resize(i - 1) = Application.Transpose(Arr)

This code works great in giving me a list of unique values. My problem is
with the rng variable. It is currently: Set rng = sh1.Range("F2:GI32").
However, what I really need it to do is set the rng from F2 through the last
cell. ???



--
Thanks
Shawn

select a range through last cell question
 

Set rng = sh1.Range(Sh1.Range("F2"),Sh1.Range("F2").End(xldo wn))
Set rng = rng.Resize(,186)

--
Regards,
Tom Ogilvy



"Shawn" wrote in message
...
I have a question about the following code:

Option Explicit
Public Sub UniqueValues()

'Searches target range and returns unique values to desired column

Dim Col As Collection
Dim Arr() As Variant
Dim rCell As Range
Dim rng As Range
Dim i As Long
Dim WB As Workbook
Dim sh1 As Worksheet
Dim ShUnVa As Worksheet

Set WB = ActiveWorkbook
Set sh1 = WB.Sheets("Sheet1")
Set ShUnVa = WB.Sheets("UniqueValues")
Set Col = New Collection
Set rng = sh1.Range("F2:GI32")


ShUnVa.Select
ShUnVa.Columns("A:A").Delete Shift:=xlToLeft


For Each rCell In rng.Cells
If Not IsEmpty(rCell.Value) Then
On Error Resume Next
Col.Add rCell.Value, CStr(rCell.Value)
On Error GoTo 0
End If
Next rCell
On Error Resume Next
ReDim Arr(1 To Col.Count)

For i = LBound(Arr, 1) To UBound(Arr, 1)
Arr(i) = Col.Item(i)
Next i

ShUnVa.Range("A1").Resize(i - 1) = Application.Transpose(Arr)

This code works great in giving me a list of unique values. My problem is
with the rng variable. It is currently: Set rng = sh1.Range("F2:GI32").
However, what I really need it to do is set the rng from F2 through the
last
cell. ???



--
Thanks
Shawn