Organise Data in Excel

[mastap2003]

Hi. I have a bit of an issue in a sheet I'm trying to create and have no Idea really where to start.

Basically I currently have a form that inputs data into my s/sheet 'Data'.

I require a button that will produce a summary (possibly message box) of the details that are in the spreadsheet in rows A,B and C. I want the form to display each of the rows that are unique only. ie.


EY18 12-Feb Y-J
EY12 12-Feb Y-J
EY20 12-Feb Y-j
EY18 12-Feb J-F
EY12 12-Feb J-F
EY20 12-Feb J-F
EY18 12-Feb Y-J
EY12 12-Feb Y-J
EY20 12-Feb Y-j
EY18 12-Feb J-F
EY12 12-Feb J-F
EY20 12-Feb J-F
EY18 12-Feb Y-J
EY12 12-Feb Y-J
EY20 12-Feb Y-j
EY18 12-Feb J-F
EY12 12-Feb J-F
EY20 12-Feb J-F

Would Return:


EY18 12-Feb Y-J
EY12 12-Feb Y-J
EY20 12-Feb Y-j
EY18 12-Feb J-F
EY12 12-Feb J-F
EY20 12-Feb J-F



Any help at all would be much appreciated.

Paul

[Rabbit]

You don't need VBA, Excel has built in functionality to remove duplicates.

[NeoPa]

There's certainly a Subtotals... option from the Data menu, but that wants something to aggregate. It also requires the data to be sorted I believe, which is also readily available from the Data menu.

[Guido Geurs]

This will search the unique data in Col "A" and set it in a MSGbox and dump it in Col"c".

Sub Search_Unique()
Dim ARRDATA() As Variant
Dim ARRDATAidx As Integer
Dim ARRUNIQUE() As Variant
Dim ARRUNIQUEidx As Variant
Dim FOUND As Boolean
Dim TEXTmsgbox As String
'§ find unique
    '§ put sheet in array
    ARRDATA = Range("A1").Resize(Range("A1").End(xlDown).Row, 1)
    '§ dim ARRUNIQUE
    ReDim ARRUNIQUE(0)
    '§ search through data
    For ARRDATAidx = LBound(ARRDATA) To UBound(ARRDATA)
        FOUND = False
        '§ search through ARRUNIQUE
        For ARRUNIQUEidx = LBound(ARRUNIQUE) To UBound(ARRUNIQUE)
            If ARRUNIQUE(ARRUNIQUEidx) = ARRDATA(ARRDATAidx, 1) Then FOUND = True
        Next
        '§ if not in ARRUNIQUE then add
        If FOUND = False Then
            ReDim Preserve ARRUNIQUE(UBound(ARRUNIQUE) + 1)
            ARRUNIQUE(UBound(ARRUNIQUE)) = ARRDATA(ARRDATAidx, 1)
        End If
    Next
'§ send msgbox
    '§ set ARRUNIQUE in text string
    For ARRUNIQUEidx = LBound(ARRUNIQUE) To UBound(ARRUNIQUE)
        TEXTmsgbox = TEXTmsgbox & ARRUNIQUE(ARRUNIQUEidx) & vbNewLine
    Next
    '§ show MSGbox
    MsgBox TEXTmsgbox
'§ dump unique
    '§ set ARRUNIQUE in a 2D array = ARRDATA
    '§ clean ARRDATA
    ReDim ARRDATA(1 To UBound(ARRUNIQUE), 1 To 1)
    '§ transfer data
    For ARRUNIQUEidx = 1 To UBound(ARRUNIQUE)
        ARRDATA((ARRUNIQUEidx), 1) = ARRUNIQUE(ARRUNIQUEidx)
    Next
    '§ dump data in sheet "C1"
    Range("C1").Resize(UBound(ARRDATA, 1), 1) = ARRDATA
End Sub