Combine multiple records into one

[LxQ]

I would like to combine records into a query. For example, the table would be

Jane, Doe, teacher, math
Jane, Doe, teacher, English

I would like the query to have:
Jane, Doe, teacher, math English

 

[Joe4]

So, in looking for records to combine, are we "grouping" on all 6 non-SUBJECT fields, i.e. combine records where all six of these fields are the same (SSN, CREDNAME, CREDENTIAL, TYPECODE, CREDTYPE, and CREDEXP) and the combine SUBJECT?

 

[DanteAmor]

LxQ,
That could be difficult to do in an Access Query (I am not sure if it is even possible).
If it was me, I would probably use VBA and DAO Recordsets, and loop through my data and write the results to a new table.

You're absolutely right, I did not check the forum, I always do, but this time I failed. I apologize

If Excel is a better solution for this, I can deal with that too.

If it's useful, add the macro

Sheet1 structure A B C D 1 First Last position subject 2 Jane Doe teacher math 3 Jane Doe teacher eng 4 Frank Smith teacher sp 5 Frank Smith teacher fi 6 Frank Smith teacher qu <colgroup><col width="80" span="4" style="width: 60pt;"></colgroup><tbody> </tbody>

<tbody>
</tbody>

Sheet2 structure A B C D E F 1 First Last position subject 1 subject 2 subject 3 2 Jane Doe teacher math eng 3 Frank Smith teacher sp fi qu <colgroup><col width="80" span="4" style="width: 60pt;"></colgroup><tbody> </tbody>

<tbody>
</tbody>

---

Sub Combine_multiple_records_into_one()
    Dim h1 As Worksheet, h2 As Worksheet
    Dim u1 As Long, u2 As Long, uc As Long, fila As Long
    Dim r As Range, b As Object
    Dim celda As String
    '
    Application.ScreenUpdating = False
    '
    Set h1 = Sheets("sheet1")
    Set h2 = Sheets("sheet2")
     h2.Rows("2:" & Rows.Count).Clear
    '
    u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To u1
        existe = False
        Set r = h2.Columns("A")
        Set b = r.Find(h1.Cells(i, "A").Value, LookAt:=xlWhole)
        If Not b Is Nothing Then
            celda = b.Address
            Do
                'detalle
                If h2.Cells(b.Row, "B").Value = h1.Cells(i, "B").Value And _
                   h2.Cells(b.Row, "C").Value = h1.Cells(i, "C").Value Then
                    existe = True
                    fila = b.Row
                    Exit Do
                End If
                Set b = r.FindNext(b)
            Loop While Not b Is Nothing And b.Address <> celda
        End If
        If existe = False Then
            u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
            h2.Cells(u2, "A").Value = h1.Cells(i, "A").Value
            h2.Cells(u2, "B").Value = h1.Cells(i, "B").Value
            h2.Cells(u2, "C").Value = h1.Cells(i, "C").Value
            h2.Cells(u2, "D").Value = h1.Cells(i, "D").Value
        Else
            uc = h2.Cells(fila, Columns.Count).End(xlToLeft).Column + 1
            h2.Cells(fila, uc).Value = h1.Cells(i, "D").Value
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "End"
End Sub

 

[LxQ]

Thank you!

 

[Joe4]

You're absolutely right, I did not check the forum, I always do, but this time I failed. I apologize

No worries! You weren't the first to do it, and I am sure that you won't be the last.
In the end, it looks like an Excel solution is acceptable.

LxQ,
If that solution works for you, I will let it be. The Access solution can get a bit tricky, and I would need to dig up some old notes.