Dynamic Concatenate along N rows and N columns

[jwwr4393]

I have some data and range to work with. I want to have all the data that is populated per row concatenated into one cell for all E:P into Cell D. For example =CONCATENATE(E2,", ",F2) etc for N values in that range of E:P. Also I would like this to populate down each column for as long as there are values N columns down. I have a VBA script that will work for The first value in column E but i cannot understand how to finagle it to be dynamic to the values in the range E2:P#, where # is the Nth row with data in it. Help me make this script work Across the columns and down the rows.

Sub Concatenate1()

Dim ws As Worksheet: Set ws = Sheets("Sheet1")

With ws.Range("E2:E" & ws.Cells(ws.Rows.Count, "E").End(xlUp).Row)
.EntireRow.Columns("D").Formula = "=" & .Cells(1).Address(0, 0)
' or
'.Offset(, 1).Formula = "=""<>""&" & .Cells(1).Address(0, 0)
End With

End Sub

Actual Result in D4 is '=E4' or 8787-0004.
desired Result in D4 is: 8787-0004, 8787-0005, 8787-0006, 8787-0015. Do this for each value in RANGE E4:P4

 

[Z51]

In newer versions of Excel, you could use the TEXTJOIN function to make quick work of this. Since you're on 2016, this may work for you...

Sub jwwr()
Dim lastrow As Long, lastcol As Long, i As Long, j As Long
Dim ws As Worksheet, myStr As String
Set ws = Sheets("Sheet1")
lastrow = ws.Range("E" & Rows.Count).End(xlUp).Row

With ws
    For i = 2 To lastrow
        lastcol = .Cells(i, Columns.Count).End(xlToLeft).Column
        For j = 5 To lastcol
            myStr = myStr & .Cells(i, j).Value & ", "
        Next j
        .Cells(i, 4).Value = Left(myStr, Len(myStr) - 2)
        myStr = ""
    Next i
End With
End Sub

 

[jwwr4393]

In newer versions of Excel, you could use the TEXTJOIN function to make quick work of this. Since you're on 2016, this may work for you...

Sub jwwr()
Dim lastrow As Long, lastcol As Long, i As Long, j As Long
Dim ws As Worksheet, myStr As String
Set ws = Sheets("Sheet1")
lastrow = ws.Range("E" & Rows.Count).End(xlUp).Row

With ws
    For i = 2 To lastrow
        lastcol = .Cells(i, Columns.Count).End(xlToLeft).Column
        For j = 5 To lastcol
            myStr = myStr & .Cells(i, j).Value & ", "
        Next j
        .Cells(i, 4).Value = Left(myStr, Len(myStr) - 2)
        myStr = ""
    Next i
End With
End Sub

I wish I was on 365... I have a blast with that at home. Work doesn't get that luxury. :/ Thanks for your reply.
That does work! Although, it generates all blanks as well. I would like to exclude the blanks in the range. Basically, if blank do nothing or stop at previous value. Much Thanks!

 

[Mortiray]

This should just be a matter of adding an If statement to the inside of the For loop where it adds to the string. Change that line to

If .Cells(i, j).Value <> "" Then myStr = myStr & .Cells(i, j).Value & ", "

Alternatively, use a separate variable for the value so you don't need to fetch from the sheet twice in one line of code

Sub jwwr()
Dim lastrow As Long, lastcol As Long, i As Long, j As Long
Dim ws As Worksheet, myStr As String
Set ws = Sheets("Sheet1")
lastrow = ws.Range("E" & Rows.Count).End(xlUp).Row

Dim curCellVal As String 'Holds the fetched value of the current cell being scanned

With ws
    For i = 2 To lastrow
        lastcol = .Cells(i, Columns.Count).End(xlToLeft).Column
        For j = 5 To lastcol
            curCellVal = .Cells(i, j).Value
            If curCellVal <> "" Then myStr = myStr & curCellVal & ", "
        Next j
        .Cells(i, 4).Value = Left(myStr, Len(myStr) - 2)
        myStr = ""
    Next i
End With
End Sub

 

[jwwr4393]

This should just be a matter of adding an If statement to the inside of the For loop where it adds to the string. Change that line to

If .Cells(i, j).Value <> "" Then myStr = myStr & .Cells(i, j).Value & ", "

Alternatively, use a separate variable for the value so you don't need to fetch from the sheet twice in one line of code

Sub jwwr()
Dim lastrow As Long, lastcol As Long, i As Long, j As Long
Dim ws As Worksheet, myStr As String
Set ws = Sheets("Sheet1")
lastrow = ws.Range("E" & Rows.Count).End(xlUp).Row

Dim curCellVal As String 'Holds the fetched value of the current cell being scanned

With ws
    For i = 2 To lastrow
        lastcol = .Cells(i, Columns.Count).End(xlToLeft).Column
        For j = 5 To lastcol
            curCellVal = .Cells(i, j).Value
            If curCellVal <> "" Then myStr = myStr & curCellVal & ", "
        Next j
        .Cells(i, 4).Value = Left(myStr, Len(myStr) - 2)
        myStr = ""
    Next i
End With
End Sub

Thanks for the help it does work with a little hiccup. The VBA pops up an error window Run-time error '5': Invalid procedure call or argument. It still gets the data arranged the way i requested. When I click Debug, it highlights: .Cells(i, 4).Value = Left(myStr, Len(myStr) - 2)