List duplicates in Excel

[jmcgill]

I am needing to create a list in Excel from one column in sheet 1 that will make up the list in a different column. The problem I have is that the 1st column(that will populate the list) may have the same entry in it several times along with several distinct entries. I dont wont to show duplicates or any blank cells in the list box. In VB I would just write a Select Distinct statement but in Excel I am not sure how this is done.

Can some one point me in the right direction?

Thanks,

Jason

[New2vba]

Wouldn't know how to write the complete code, but I would do this using an array.

1. Add the value of the first cell in your source range to your array.
2. Check if the value of the second cell is the same as the first entry in the array. If it is not increase the array size by one (ReDim Preserve) and add the cells value. If it is the same, ignore it.
3. Repeat step 2 for all other cells in your source range, but each time checking the value of the cell against all entries in the array. If the cells value already exists do nothing. If it doesn't exist redim and add.
4. Add your array to the required column (each individual entry being added to its own cell).

Hope this makes sense.

[jmcgill]

it makes sense but i do not know much about vba in excel. any idea where i can get an example?

[New2vba]

Replaced by next post

EDIT:

Don't know if it helps, but you can actually find duplicates without vba. See http://office.microsoft.com/en-us/as...366161033.aspx

[New2vba]

This one really played on my mind so I had another attempt and think I've managed it

Try this code:

'Change the default index of the first element in the array from 0 to 1
Option Base 1
 
Sub CopyList()
 
Dim NewList() As String
Dim shtSource As Worksheet
Dim shtTarget As Worksheet
Dim i As Long
Dim j As Long
Dim k As Long
Dim Flag As Long
 
'Set source and target worksheets
Set shtSource = ActiveWorkbook.Worksheets("Sheet1")
Set shtTarget = ActiveWorkbook.Worksheets("Sheet2")
 
'Set flag to zero
Flag = 0
 
'Redim array and add first list item from A1
ReDim NewList(1) As String
NewList(1) = shtSource.Cells(1, 1)
 
 
'Assuming a source range of A1:A9 (A1 has already been added to the list)
For i = 2 To 9
    For j = LBound(NewList) To UBound(NewList)
        'Check if i'th source cell is same as j'th value in array
        If shtSource.Cells(i, 1) <> NewList(j) Then
            'If item is unique add flag
            Flag = Flag + 1
        End If
    Next j
        'If every check flagged then item is unique
        If Flag = UBound(NewList) Then
            'Redim array and add unique value
            ReDim Preserve NewList(UBound(NewList) + 1)
            NewList(UBound(NewList)) = shtSource.Cells(i, 1)
            'Reset flag
            Flag = 0
        Else
            'Reset flag
            Flag = 0
        End If
Next i
 
'Add the completed array to the target range
For k = LBound(NewList) To UBound(NewList)
    shtTarget.Cells(k, 1) = NewList(k)
Next k
 
End Sub

I've tried it with several different ranges and it seems to work fine. I've also attached a sample spreadsheet with the working code.

Let me know if it solves your problem.