Concatenate cells in a column if there is a value in the row
Asked Answered
U

3

1

I'm a novice in Excel macros so i'm looking out for some assistance to create a macro which would allow me to concatenate the values in the columns of an excel sheet containing details in the following format.

Existing format of Excel Sheet

I need the data to be presented in below format

Desired format of Excel Sheet

I have tried searching on several online forums for a solution and even tried different combinations of functions using concatenate, if and Isblank but I'm unable to achieve the desired result. I apologize in advance in case the solution is something very simple that I may have overlooked but I've been racking my brains on this problem since last couple of days and I hope I can find the solution to my problem on this forum. Any help and guidance would be highly appreciated.

Thanks in advance.

Unnamed answered 30/7, 2021 at 14:12 Comment(8)
all formula recommendations would be made simpler if you would create a helper column that fills in the date on every row.Falla
Also do you prefer a formula or VBA (you tagged both). What Excel version do you use?Aleshia
Power Query can help you here. Lock for unpivot.Potassium
@Aleshia : I'm using Microsoft Office 365 and if given a choice, I would prefer a formula over VBA as I'm a complete novice in VBA.Unnamed
are you willing to have a helper column?Falla
@ScottCraner : I created the helper column as suggested by you that fills in the date on every row but I'm not sure how to proceed furtherUnnamed
=IF(A1<>"",TEXTJOIN(" ",TRUE,FILTER(B:B,C:C=A1)) where C:C is the helper.Falla
Can you explain first voting and than invoting my solution ?Aleshia
C
2

I think the procedure below will do what you expect of it. Please try.

Sub ConcatEntries()
    ' 299

    Const TitleClm      As String = "A"     ' change to suit
    Const ItemClm       As String = "B"     ' change to suit
    Const FirstDataRow  As Long = 2         ' change to suit
    
    Dim Spike()         As String           ' for output
    Dim i               As Long             ' index of Spike()
    Dim Concat          As String           ' concatenation
    Dim R               As Long             ' loop counter: sheet rows
    
    Application.ScreenUpdating = False
    ' the number of Spike elements should be much larger than what you ever expect
    ReDim Spike(1 To 100)                   ' prepare for results
    i = UBound(Spike)
    With Worksheets("Sheet1")               ' change to suit
        ' loop from last used cell to FirstDataRow
        For R = (.Cells(.Rows.Count, ItemClm).End(xlUp).Row) To FirstDataRow Step -1
            i = i - 1
            Spike(i) = .Cells(R, ItemClm).Value & " "
            If Len(.Cells(R, TitleClm).Value) Then
                .Cells(R, ItemClm).Value = Trim(Join(Spike))
                ReDim Spike(UBound(Spike))
                i = UBound(Spike)
            Else
                .Rows(R).Delete
            End If
        Next R
    End With
    Application.ScreenUpdating = True
End Sub

Please take note of the three constants at the top of the code. You can adjust their values to meet set setup in your worksheet. You may also change the name of the worksheet on which the action is taking place in the code. My code refers to "Sheet1".

Clime answered 30/7, 2021 at 15:23 Comment(0)
V
4

This is after the answer, but the problem is interesting. Here is a formula with no helper:

=LET( data, A1:B11,
   dates, INDEX(data, , 1),
     rseq, SEQUENCE( ROWS( data ) ),
     nb, NOT(ISBLANK(dates)),
     dateCol, INDEX(FILTER(dates,nb),MMULT(--( rseq >= TRANSPOSE( rseq ) ), --nb )),
   table, CHOOSE( {1,2}, dateCol, SUBSTITUTE(INDEX( data, , 2),0,"") ),
   uDates, TRANSPOSE(UNIQUE(dateCol)),
   CTA, SUBSTITUTE(UNIQUE(TRANSPOSE(IF(dateCol=uDates,INDEX(table, , 2),"")),TRUE),0,""),
   cStr, LET( m, CTA,
               rSeq, SEQUENCE( ROWS(m) ),
               L, MMULT( LEN(m)--(m<>""), SIGN( SEQUENCE( COLUMNS(m) ) ) ) - 1,
               i, MMULT(--( TRANSPOSE( rSeq ) < rSeq ), L ) + rSeq,
              IFERROR( MID( TEXTJOIN( " ", TRUE, m ), i, L ), "" ) ),
   CHOOSE( {1,2}, TRANSPOSE(uDates), cStr )  )

where the input A1:B11 is placed in data. Yes, this can be simplified as it is stitching two solutions together, but as the answer is already confirmed and there is already a clean non-VBA solution, it is better to leave all the parts exposed.

Vermont answered 30/7, 2021 at 17:4 Comment(4)
Nested LET, I know just one person who could've think of that.Aleshia
LOL! - What led me to Stack was a need for a formulaic unpiv and when I did not find one that worked, I wrote one. This led to recycling an old idea: with LAMBDA, we will be able to make a library similar to what I built using VBA in the late 90's called SHBIXL (should be in XL). The question is: what would one put in a 2020's LAMBDA SHBIXL? What seems to be most useful are just parts - repeating patterns so that you can extend Excel functions into more robust solutions. And, so far, I am seeing lots of useful patterns to make parts - yours are among those. Can't wait for LAMBDA.Vermont
@Aleshia - so the above comment explains why I have been so intensely focused on LET based solutions and nested LET. With these parts created by LETs, we can create LAMBDAs to make more a comprehensive set of functions that serve general, but rare needs, like RESHAPE, UNPIV, MELT, SPLIT, ...Vermont
I should look into LAMBDA as well. I think it's not available on phone, but I have a (very crooked) laptop as well. The kids dropped it (I think) and keyboard is not responding well, so I use the phone a lot.Aleshia
C
2

I think the procedure below will do what you expect of it. Please try.

Sub ConcatEntries()
    ' 299

    Const TitleClm      As String = "A"     ' change to suit
    Const ItemClm       As String = "B"     ' change to suit
    Const FirstDataRow  As Long = 2         ' change to suit
    
    Dim Spike()         As String           ' for output
    Dim i               As Long             ' index of Spike()
    Dim Concat          As String           ' concatenation
    Dim R               As Long             ' loop counter: sheet rows
    
    Application.ScreenUpdating = False
    ' the number of Spike elements should be much larger than what you ever expect
    ReDim Spike(1 To 100)                   ' prepare for results
    i = UBound(Spike)
    With Worksheets("Sheet1")               ' change to suit
        ' loop from last used cell to FirstDataRow
        For R = (.Cells(.Rows.Count, ItemClm).End(xlUp).Row) To FirstDataRow Step -1
            i = i - 1
            Spike(i) = .Cells(R, ItemClm).Value & " "
            If Len(.Cells(R, TitleClm).Value) Then
                .Cells(R, ItemClm).Value = Trim(Join(Spike))
                ReDim Spike(UBound(Spike))
                i = UBound(Spike)
            Else
                .Rows(R).Delete
            End If
        Next R
    End With
    Application.ScreenUpdating = True
End Sub

Please take note of the three constants at the top of the code. You can adjust their values to meet set setup in your worksheet. You may also change the name of the worksheet on which the action is taking place in the code. My code refers to "Sheet1".

Clime answered 30/7, 2021 at 15:23 Comment(0)
A
0

In the first column use =FILTER(A:A,A:A<>"") to create a spill-range for the dates. In the column next to it use=IFERROR(TEXTJOIN(" ",1,INDEX(B:B,MATCH(C1,A:A,0)):INDEX(B:B,MATCH(1,(A:A<>"")*(ROW(A:A)>MATCH(C1,A:A,0)),0)-1)),TEXTJOIN(" ",1,INDEX(B:B,MATCH(C1,A:A,0)):INDEX(B:B,MAX((B:B<>"")*ROW(B:B))))) It uses index to get the start of the range from where the date matches up to the next date (minus 1) and an error-handling for the last range, where it looks for the last non-empty row in column B.

Of course you need to refer to the correct sheet when referencing the ranges. It's also recommended to narrow down the ranges for better performance.

Aleshia answered 30/7, 2021 at 16:1 Comment(3)
Really nice work again. Please tell me you did not do it on your phone. ;-) I think it could be stitched into a LET with no helper. Will give that a try as a learning exercise.Vermont
Yes on the phone, it crossed my mind to make it a all at once formula, but than I figured it's most likely that the user is helped better with a solution that he may be able to replicate in similar situations. But yeah it's fun to achieve it, agreed. Splendid job again. Nice going through your Formula Creation.Aleshia
Bon point regarding the use of helper cells - it is easier to control the shape of the output. Spill ranges are elegant, but they can also be impractical. As for the phone... I tried to use excel for iOS in 2009 - this nearly resulted in a cracked screen, but I found the presence of mind to simply close it, uninstall it and walk away. I suppose I should give it another try, but too much PTSD from the first try.Vermont

© 2022 - 2024 — McMap. All rights reserved.