Home > Blockchain >  In VBA, concatenate multiple rows of text data until a criteria is met, then loop this process
In VBA, concatenate multiple rows of text data until a criteria is met, then loop this process

Time:10-13

I am working in Excel and writing a macro in VBA. The data I am working with looks like this:

AssetID Details Other
1 Bob likes fruit Bob is a champion
Bob likes to play
Bob is a bat
Bob likes to play cricket Bob is a genius
2 Michael goes hiking Michael likes juice
Michael hates test data

There are more columns to the right, but a low number (say 10 total). There are normally ~2,000 rows.

What I want to do is combine all this text data so that I end up with one row per AssetID. So all the text in the Details column for AssetID 1 would be merged into B2, and all the text in the Other column for AssetID 1 would be merged into C2.

The text data can simply be concatenated with a line break or two, but it would be ideal if it skipped over blank lines.

And naturally, I'd like to end this process when we hit the end of the table - this isn't signified well, but maybe we can use UsedRange or test for a completely blank row?

I think I understand one workable concept here as something like:

  • Count the number of non-blank AssetIDs in the range A2:A999 - say n AssetIDs
  • Start at the first AssetID ("ID") in cell A2
  • Head downwards, counting m blank cells below that AssetID
  • Establish a range with m rows and 9 columns, starting from the cell to the right of "ID"
  • For each column, concatenate all the cells in the range into the first cell in the column
  • At this point, we have fixed one AssetID
  • Set our new ID, which should be m 1 rows below our previous ID
  • Repeat this loop n times in total, therefore fixing all of them

I just can't actually get it into code! Appreciate any help you can provide.

Another possibility that came to mind would be "filling in" the missing AssetIDs - e.g. starting from A3, test if A3 is blank. If yes, then set A3=A2. If not, then proceed.

That would correctly assign every row with an AssetID, and perhaps there's a faster way to then concatenate all the data in each column with the same AssetID... but I don't know exactly how to execute that.

CodePudding user response:

If I understand what you are looking for, this bit of code should get you going. The code expects your data sheet to be the active sheet when it is run (that can be changed). It concatenates the data for each asset into one cell but keeps the separate lines and places the information on a new worksheet so that the original data isn't edited by the code.

Sub MergeData()
    Dim xlCellA As Range
    Dim xlCellB As Range
    Dim sDetails As String
    Dim sOther As String
        Set xlCellA = ActiveSheet.Range("A2")
        ActiveWorkbook.Sheets.Add.Name = "New_Data"
        Set xlCellB = Sheets("New_Data").Range("A2")
        Do Until xlCellA.Value = "" And xlCellA.Offset(0, 1).Value = "" And xlCellA.Offset(0, 2).Value = ""
            xlCellB = xlCellA
            sDetails = xlCellA.Offset(0, 1).Value
            sOther = xlCellA.Offset(0, 2).Value
            Set xlCellA = xlCellA.Offset(1, 0)
            Do While xlCellA.Value = "" And (xlCellA.Offset(0, 1).Value <> "" Or xlCellA.Offset(0, 2).Value <> "")
                If xlCellA.Offset(0, 1).Value <> "" Then sDetails = sDetails & vbCrLf & xlCellA.Offset(0, 1).Value
                If xlCellA.Offset(0, 2).Value <> "" Then sOther = sOther & vbCrLf & xlCellA.Offset(0, 2).Value
                Set xlCellA = xlCellA.Offset(1, 0)
            Loop
            With xlCellB
                .Offset(0, 1).Value = sDetails
                .Offset(0, 2).Value = sOther
            End With
            Set xlCellB = xlCellB.Offset(1, 0)
        Loop
End Sub

CodePudding user response:

This can also be accomplished using Power Query, available in Windows Excel 2010 and Excel 365 (Windows or Mac)

To use Power Query

  • Select some cell in your Data Table
  • Data => Get&Transform => from Table/Range or from within sheet
  • When the PQ Editor opens: Home => Advanced Editor
  • Make note of the Table Name in Line 2
  • Paste the M Code below in place of what you see
  • Change the Table name in line 2 back to what was generated originally.
  • Read the comments and explore the Applied Steps to understand the algorithm
let
    Source = Excel.CurrentWorkbook(){[Name="Table5"]}[Content],

//List all columns except the first
    #"Columns to Combine" = List.Buffer(List.RemoveFirstN(Table.ColumnNames(Source))),

//set data types: AssetID=integer; other columns are text
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"AssetID", Int64.Type}} &  
        List.Transform(#"Columns to Combine", each {_, type text})),

//Fill down the Asset Id,
//   Then Group on AssetID
//   Custom aggregation to combine all entries in columns other than AssetID
//      removing blanks and concatenating with line feed    
    #"Filled Down" = Table.FillDown(#"Changed Type",{"AssetID"}),
    #"Grouped Rows" = Table.Group(#"Filled Down", {"AssetID"}, {
        {"Details", (t)=> 
            Text.Combine(
                List.RemoveNulls(
                    List.Accumulate(#"Columns to Combine", {}, (state, current)=>
                        state & Table.Column(t,current))),"#(lf)"), type text}})
in
    #"Grouped Rows"

enter image description here

  • Related