I have a table of data in sheet2 in rows A:F.

I would like a VBA that would search through these rows and list the unique
values only in sheet1 column A

Please help and thanks in advance


--
Thanks
Shawn

Hi Shawn,

Try:

'================================
Public Sub Tester03()
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 Sh2 As Worksheet

Set WB = ActiveWorkbook
Set sh1 = WB.Sheets("Sheet2")
Set Sh2 = WB.Sheets("Sheet1")
Set Col = New Collection
Set rng = sh1.Columns("A:F")

Application.ScreenUpdating = False

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

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

Application.ScreenUpdating = True

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


---
Regards,
Norman



"Shawn" wrote in message
...
I have a table of data in sheet2 in rows A:F.

I would like a VBA that would search through these rows and list the
unique
values only in sheet1 column A

Please help and thanks in advance


--
Thanks
Shawn

norman,

use a scripting dictionary iso a collection.
you gain speed as you can directly retrieve the dictionary's
items array iso recreating it as you must with a collection.

added benefit, you can make it case sensitive

--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Norman Jones wrote :

Hi Shawn,

Try:

'================================
Public Sub Tester03()
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 Sh2 As Worksheet

Set WB = ActiveWorkbook
Set sh1 = WB.Sheets("Sheet2")
Set Sh2 = WB.Sheets("Sheet1")
Set Col = New Collection
Set rng = sh1.Columns("A:F")

Application.ScreenUpdating = False

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

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

Application.ScreenUpdating = True

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


---
Regards,
Norman



"Shawn" wrote in message
...
I have a table of data in sheet2 in rows A:F.

I would like a VBA that would search through these rows and list
the unique values only in sheet1 column A

Please help and thanks in advance


-- Thanks
Shawn

Hi Jurgen,

Good suggestion!


---
Regards,
Norman



"keepITcool" wrote in message
.com...
norman,

use a scripting dictionary iso a collection.
you gain speed as you can directly retrieve the dictionary's
items array iso recreating it as you must with a collection.

added benefit, you can make it case sensitive

--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Norman Jones wrote :

Hi Shawn,

Try:

'================================
Public Sub Tester03()
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 Sh2 As Worksheet

Set WB = ActiveWorkbook
Set sh1 = WB.Sheets("Sheet2")
Set Sh2 = WB.Sheets("Sheet1")
Set Col = New Collection
Set rng = sh1.Columns("A:F")

Application.ScreenUpdating = False

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

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

Application.ScreenUpdating = True

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


---
Regards,
Norman



"Shawn" wrote in message
...
I have a table of data in sheet2 in rows A:F.

I would like a VBA that would search through these rows and list
the unique values only in sheet1 column A

Please help and thanks in advance


-- Thanks
Shawn