Consulting

Results 1 to 4 of 4

Thread: combining related records into one

  1. #1
    VBAX Contributor
    Joined
    Jun 2004
    Location
    Texas
    Posts
    139
    Location

    combining related records into one

    Hi, all,

    I'm hoping someone can assist me with this. I work with VBA in Access a lot, but I don't have much experience programming in Excel.

    I have a spreadsheet of data, specifically, a list of documents and meetings related to those documents. (I've attached a really over-simplified example to illustrate.) You might have three meetings for Document One, so there are three records, but most of the fields are simply repeated values. I'd like to concatenate all the meetings for a particular document into the cell for just one record. This way you won't have to see multiple records, just multiple values listed in one cell.

    But if each document may have any unpredictable number of meetings/records, I'm not sure how to tell Excel to loop through, find all repeated instances of a Document ID number, and concatenate the associated Meeting values into one record, then delete the other records.

    I hope this question makes sense. Look at my attached Excel sheet for (better?) illustration. Thanks in advance for any advice!!
    With program specs this fickle, you've just got to believe in Discord.

  2. #2
    Knowledge Base Approver
    The King of Overkill!
    VBAX Master
    Joined
    Jul 2004
    Location
    Rochester, NY
    Posts
    1,727
    Location
    Hi eed,

    Try the following macro:

    [VBA]Sub eedCombiningRelatedRecordsIntoOne()
    'http://www.vbaexpress.com/forum/showthread.php?t=719
    Dim TopDocID As Range, DocID As Range, Mtgs As String, RowsToDel As Range, rHgt As Double
    For Each DocID In Range("A3", Range("A65536").End(xlUp))
    If DocID <> DocID.Offset(-1, 0) Then
    Set TopDocID = DocID
    Mtgs = DocID.Offset(0, 2)
    rHgt = DocID.RowHeight
    Else
    Mtgs = Mtgs & vbLf & DocID.Offset(0, 2)
    rHgt = rHgt + DocID.RowHeight
    If RowsToDel Is Nothing Then
    Set RowsToDel = DocID.EntireRow
    Else
    Set RowsToDel = Union(RowsToDel, DocID.EntireRow)
    End If
    End If
    If DocID <> DocID.Offset(1, 0) Then
    TopDocID.RowHeight = rHgt
    TopDocID.Offset(0, 2).WrapText = True
    TopDocID.Offset(0, 2) = Mtgs
    End If
    Next
    RowsToDel.Delete shift:=xlUp
    End Sub[/VBA]


    This assumes your data starts in Cell A3 and the docIDs are in column A. Let us know if you need any help!
    Matt

  3. #3
    VBAX Contributor
    Joined
    Jun 2004
    Location
    Texas
    Posts
    139
    Location
    Matt,

    This code looks fantastic. I had to modify it a little bit to execute the Excel commands from my Access code, but that was no trouble. Just one quick question to make sure: it should still run properly if I change "A3" to "A2", correct?

    Thank you so much for your help, this code was a real life-saver!!!!

    - Erin

  4. #4
    Knowledge Base Approver
    The King of Overkill! VBAX Master
    Joined
    Jul 2004
    Location
    Rochester, NY
    Posts
    1,727
    Location
    Hi Erin,

    It should still run fine changing A3 to A2, I just used A3 based on your sample report. I'm glad I could help!

    Matt

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •