Grouping in Excel with Macro 2

[Bilberry]

hi All,
I have the following information:
Date Name Code
20-11-2013 Mike KKT
20-11-2013 Mike HGK
20-11-2013 Mike MMK
20-11-2013 Michael HGK
21-11-2013 Edward ZZQ

I want to put Group this information by name and date i want to put the code's in a cell separated with a comma, so it should be:

20-11-2013 Mike KKT, HGK, MMK
20-11-2013 Michael HGK
21-11-2013 Edward ZZQ

How to handle this in excel with a macro? A star for the solution.
Thanks a lot!

 

[SkipVought]

hi,

What code do you have so far?

Where are you stuck?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Bilberry]

Hi Skip,
I only have the macro (recorded) for grouping, but dont know how to put values in one cell with a comma. Thats the only difficult part...

 

[SkipVought]

this function can be used directly on the sheet like any spreadsheet formula, of in VBA code. You must supply the date and name references.

I named the sheet that the data is on [highlight]SOURCE[/highlight] you can change accordingly.

Function ListCodes(dte As Date, nme As String) As String
    Dim sConn As String, sSQL As String
    Dim rst As ADODB.Recordset, cnn As ADODB.Connection
    Dim sPath As String, sDB As String
    
    sPath = ThisWorkbook.Path
    sDB = ThisWorkbook.Name
    
    Set cnn = New ADODB.Connection

    sConn = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};"
    sConn = sConn & "DBQ=" & sPath & "\" & sDB & ";"
     
    cnn.Open sConn
    
    Set rst = New ADODB.Recordset
        
    sSQL = sSQL & "SELECT CODE"
    sSQL = sSQL & vbLf
    sSQL = sSQL & "FROM `" & sPath & "\" & sDB & "`.`[highlight]SOURCE[/highlight]$`"
    sSQL = sSQL & vbLf
    sSQL = sSQL & "WHERE Date=#" & Format(dte, "yyyy-mm-dd") & "#"
    sSQL = sSQL & "  AND Name='" & nme & "'"
    
    With rst
       .Open sSQL, cnn, adOpenStatic, adLockReadOnly, adCmdText
       
        On Error Resume Next
        
        .MoveFirst
        
        Do While Not .BOF And Not .EOF
            ListCodes = ListCodes & .Fields(0).Value & ","
            .MoveNext
        Loop
        
        ListCodes = Left(ListCodes, Len(ListCodes) - 1)
    
       .Close
    End With
    
    cnn.Close
    
    Set rst = Nothing
    Set cnn = Nothing
End Function

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

Oh, BTW, you must set a reference in the VB Editor in Tools > Reference to Microsoft ActiveX Data Object n.m Library

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Bilberry]

Skip i love you!

 

[SkipVought]

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Andrzejek]

You can also do:

If you data looks like:
[pre]
A B C
Date Name Code
1 20-11-2013 Mike KKT
2 20-11-2013 Mike HGK
3 20-11-2013 Mike MMK
4 20-11-2013 Michael HGK
5 21-11-2013 Edward ZZQ
[/pre]

Dim strDate As String
Dim strName As String
Dim strCode As String
Dim strC As String

Dim i As Integer

i = 2

Do While Range("A" & i).Value <> ""
    If Range("A" & i).Value <> strDate Or Range("B" & i).Value <> strName Then
        If strDate <> "" Then
            MsgBox "Date: " & strDate & ", Name: " & strName & ", Code: " & strCode
        End If
        strDate = Range("A" & i).Value
        strName = Range("B" & i).Value
        strCode = Range("C" & i).Value
    Else
        strCode = strCode & ", " & Range("C" & i).Value
    End If
    i = i + 1
Loop

MsgBox "Date: " & strDate & ", Name: " & strName & ", Code: " & strCode

Different way to 'skin the cat'

Have fun.

---- Andy