Concatenate columns without formula in private sub worksheet_change

[Ashley91]

Hello, I have been trying to research how to concatenate columns (separator should be a new line) while typing on the sheet.
What I know is I will have to use worksheet_change. What I also know is how to concatenate using either the concatenate function and using & however I need the column to not show any formulas and that column should show the concatenated columns while typing.

May I humbly ask for someone to give me ideas where to begin, please? I appreciate you all. Thank you in advance!

[arnelgp]

sample to concat columns A, B, C when A or B or C has any change:


Private Sub Worksheet_Change(ByVal Target As Range)
Const columns As String = "$A/$B/$C"
Dim rw As Long, var As Variant
If InStr(1, columns, Left$(Target.Address, 2), vbTextCompare) Then
rw = Target.Row
var = Split(columns, "/")
Range("d" & Target.Row) = Range(var(0) & rw) & vbCrLf & Range(var(1) & rw) & vbCrLf & Range(var(2) & rw)
End If
End Sub

[Ashley91]

I can't figure out how to do 6 columns -_-
And does this work on all rows or just one?

[arnelgp]

what are the columns to Concat?, you add it to the columns Constant (separated by /)

[Ashley91]

"$D/$H/$M/$N/$O/$P"
should show on Q
already tried but didn't work
I also changed Range("d" & Target.Row) to Q, but it only showed the first three columns

[arnelgp]

Private Sub Worksheet_Change(ByVal Target As Range)
Const columns As String = "$D/$H/$M/$N/$O/$P"
Dim rw As Long, var As Variant, v As Variant
Dim s As String, i As Integer
If InStr(1, columns, Left$(Target.Address, 2), vbTextCompare) Then
rw = Target.Row
var = Split(columns, "/")
For i = 0 To UBound(var)
v = Range(var(i) & "$" & rw).Value
If Not IsEmpty(v) Then
s = s & v & vbCrLf
End If
Next
If Len(s) Then
s = Left$(s, Len(s) - 2)
End If
Range("Q" & rw) = s
End If
End Sub

[p45cal]

and that column should show the concatenated columns while typingThat will never happen with a Worksheet_Change event, in fact I doubt it's possible without a lot more coding.
However, here's a version that should work after you've made changes. It will even work if you cut and paste to many cells at once, or you update non-contiguous ranges at once:

Private Sub Worksheet_Change(ByVal Target As Range)
Set myRng = Intersect(Target, Range("D:D,H:H,M:P"))
If Not myRng Is Nothing Then
For Each cll In myRng
Cells(cll.Row, "Q") = Join(Array(Cells(cll.Row, "D").Text, Cells(cll.Row, "H").Text, Cells(cll.Row, "M").Text, Cells(Target.Row, "N").Text, Cells(cll.Row, "O").Text, Cells(cll.Row, "P").Text), vbLf)
Next cll
End If
End Sub

If there's an empty cell(s) among those you want concatenating it currently shows a blank line; this can easily be changed. Knowing which version of Excel you're using would be useful too.

[Ashley91]

That will never happen with a Worksheet_Change event, in fact I doubt it's possible without a lot more coding.
However, here's a version that should work after you've made changes. It will even work if you cut and paste to many cells at once, or you update non-contiguous ranges at once:

Private Sub Worksheet_Change(ByVal Target As Range)
Set myRng = Intersect(Target, Range("D:D,H:H,M:P"))
If Not myRng Is Nothing Then
For Each cll In myRng
Cells(cll.Row, "Q") = Join(Array(Cells(cll.Row, "D").Text, Cells(cll.Row, "H").Text, Cells(cll.Row, "M").Text, Cells(Target.Row, "N").Text, Cells(cll.Row, "O").Text, Cells(cll.Row, "P").Text), vbLf)
Next cll
End If
End Sub

If there's an empty cell(s) among those you want concatenating it currently shows a blank line; this can easily be changed. Knowing which version of Excel you're using would be useful too.


Yes that's what I meant :D
I am using 365 :)

[p45cal]

So you're happy with the spaces (linefeeds) showing for blank cells in column Q?

[Ashley91]

Can those be removed? :D

[arnelgp]

That will never happen with a Worksheet_Change event, in fact I doubt it's possible without a lot more coding.
However, here's a version that should work after you've made changes. It will even work if you cut and paste to many cells at once, or you update non-contiguous ranges at once:

actually if you delete all cells from the worksheet, you'll end up in endless loop?

[p45cal]

actually if you delete all cells from the worksheet, you'll end up in endless loop?
Yes!
My coding there is very poor, crass even, not to have considered that (and a number of other things!)
It's not actually an endless loop (6.3 million iterations) but it might as well be, especially as I didn't disable screen updating and Events!

I've been experimenting with a few things, but come across a bit of a problem when more than 10000 rows are changed at once; for 10000 rows it takes 10 seconds, for 50000 rows it takes 5 minutes.
I'll look at it again later and try to reduce the sheet reads/writes count so that any number of rows/cells can be changed processing time is reduced to an insignificant level.

In the meantime change the line:
Cells(cll.Row, "Q") = Join(Array(Cells(cll.Row, "D").Text, Cells(cll.Row, "H").Text, Cells(cll.Row, "M").Text, Cells(Target.Row, "N").Text, Cells(cll.Row, "O").Text, Cells(cll.Row, "P").Text), vbLf)
(which by the way had an error in it (red)), to:

Cells(cRow, "Q") = Application.TextJoin(vbLf, True, Cells(cRow, "D").Text, Cells(cRow, "H").Text, Cells(cRow, "M").Text, Cells(cRow, "N").Text, Cells(cRow, "O").Text, Cells(cRow, "P").Text)
and don't go changing too many cells at once!

As a matter of interest, are these cells that you're looking at part of a proper Excel table (as in Insert|Tables|Table)? It would make things a lot easier if they were (even if column Q is outside that table).

Software development is a battle to make the code foolproof… the fools always win.

[p45cal]

Here's one that should be faster. On testing, max time of update was 60 secs on processing 26,000 non-contiguous rows. Entire columns (1 million+ row) 12 secs, total delete of all cells, no time at all.
I await bug reports.

Private Sub Worksheet_Change(ByVal Target As Range)
If Application.CountBlank(Cells) <> Cells.CountLarge Then 'if you delete all cells on the sheet
ApScUp = Application.ScreenUpdating 'store existing setting ('cos Worksheet_Change can be called from other codeinstead of being triggered; rare, I know.
ApEnEv = Application.EnableEvents
On Error GoTo handling
Set myrng = Intersect(Target, Range("D:D,H:H,M:P"), UsedRange).EntireRow
If Not myrng Is Nothing Then
Set myrng = Union(myrng, myrng) 'this changes the range from the likes of 7:10,12:12,12:12,12:12,2:2,2:4,2:2,6:7,6:10,6:7 to this:12:12,2:4,6:10
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each are In myrng.Areas
areVals = Intersect(are, Range("D:P")).Value
ReDim Results(1 To UBound(areVals), 1 To 1)
For i = 1 To UBound(areVals)
Results(i, 1) = Application.TextJoin(vbLf, True, areVals(i, 1), areVals(i, 5), areVals(i, 10), areVals(i, 11), areVals(i, 12), areVals(i, 13))
Next i
Intersect(are, Range("Q:Q")) = Results
Next are
handling:
Application.EnableEvents = ApEnEv 'restore original settings
Application.ScreenUpdating = ApScUp
End If
End If
End Sub

[p45cal]

If you delete an entire column - nothing happens
Very variable success with non-contiguous ranges
If many cells are changed you can still get into a seemingly endless loop.

[Ashley91]

Hey guys, I haven't been able to check your replies as I had an accident last Friday. I am still recovering. I will try this out as soon as I go back to work. I really appreciate the time you all are giving me. :)

[p45cal]

If you delete an entire column - nothing happens
Very variable success with non-contiguous ranges
If many cells are changed you can still get into a seemingly endless loop.

The message that this is a comment on has since disappeared and so it's now a bit of nonsense!

[arnelgp]

there is similar request here: Automatically conjoin columns (vbaexpress.com) (http://www.vbaexpress.com/forum/showthread.php?69355-Automatically-conjoin-columns)
i made changes to the sub so copy and paste on multiple cells is possible.
also not very complex code.