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:

    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
    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
  •