Hi
hope you can help here!
in worksheet 2, column B i have a series of identifying numbers these repeat
themselves along the column.
I like to have these appearing in worksheet 1 colum A in once only.
is this possible?
thanks, resi
Since you also want to have the list of unique entries also update when you
alter the list in column B, this can be done with a VBA event-triggered macro.
This one produces a sorted list of unique values (binary sort order). It omits
<blank>'s from the list. Read the comments in the macro for further
information.
To enter this event-triggered Macro, right click on the Sheet2 tab.
Select "View Code" from the right-click drop-down menu.
Then paste the code below into the window that opens.
==========================================
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'First row in range is assumed to be a label
Dim AOI As Range, AOIc As Range, AOIf As Range
Dim c As Range
Dim cNumList As Collection
Dim i As Long
Dim Temp()
Set AOI = Worksheets("sheet2").Range("B:B")
Set AOI = AOI.Resize(AOI.Rows.Count - 1, 1).Offset(1, 0)
If Not Intersect(AOI, Target) Is Nothing Then
Set cNumList = New Collection
On Error Resume Next
Set AOIc = AOI.SpecialCells(xlCellTypeConstants)
For Each c In AOIc
cNumList.Add c.Value, CStr(c.Value)
Next c
'You may delete the next four lines if the ID Numbers will
'ALWAYS be entered directly, and will NEVER be the result
'of a formula.
Set AOIf = AOI.SpecialCells(xlCellTypeFormulas)
For Each c In AOIf
cNumList.Add c.Value, CStr(c.Value)
Next c
On Error GoTo 0
ReDim Temp(0 To cNumList.Count - 1)
For i = 1 To cNumList.Count
Temp(i - 1) = cNumList(i)
Next i
SingleBubbleSort Temp 'Delete this line and the Private Sub
'below if sorting is not desired
With Worksheets("sheet1")
.Range("A:A").ClearContents
.Range("A1").Value = Range("ID_Numbers").Cells(1, 1).Value
For i = 2 To UBound(Temp) + 2
.Cells(i, 1).Value = Temp(i - 2)
Next i
End With
End If
End Sub
Private Sub SingleBubbleSort(TempArray As Variant)
'copied directly from support.microsoft.com
Dim Temp As Variant
Dim i As Integer
Dim NoExchanges As Integer
' Loop until no more "exchanges" are made.
Do
NoExchanges = True
' Loop through each element in the array.
For i = 0 To UBound(TempArray) - 1
' If the element is greater than the element
' following it, exchange the two elements.
If TempArray(i) > TempArray(i + 1) Then
NoExchanges = False
Temp = TempArray(i)
TempArray(i) = TempArray(i + 1)
TempArray(i + 1) = Temp
End If
Next i
Loop While Not (NoExchanges)
End Sub
=================================
--ron
