Concatenating Cells With A Variable Column Count

[Ark68]

I am hoping someone is able to help me complete this puzzle ... I know what I need to do, just not how to do it efficiently.

I have several rows in my database. Columns "R" and beyond may hold hold text values. What I need to do is combine all the values from column "R" to and including the last column in that row holding data.

For example =
if .cells( row, 18) is empty, nothing to concatenate
if .cells( row, 18) is the last column in that row with data than .cells( row, 18) remains unchanged
if .cells( row, 19) is the last column, .cells( row, 18) = .cells( row, 18) & "; " & .cells( row, 19).
if .cells( row, 22) is the last column with data, .cells( row, 18) = all the values joined from .cells( row, 18) to and including .cells( row, 22), each separated by "; "

I'm unsure how to do this efficiently.

This is where I have made it so far ...

    With worksheet       
        For i = 2 To lrow
            lcol = .Cells(i, .Columns.Count).End(xlToLeft).Column
            If lcol > 17 Then 'there are notes
                'code to combine values from column 18 on as needed
            End If
        Next i
    End with

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG27Apr24
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, R [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Application.ScreenUpdating = False
[COLOR="Navy"]Set[/COLOR] Rng = Range("A2").CurrentRegion
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Columns(18).Cells
    Lst = Cells(Dn.Row, Columns.Count).End(xlToLeft).Column
    [COLOR="Navy"]If[/COLOR] Dn.Offset(, 1) <> "" [COLOR="Navy"]Then[/COLOR]
        R = Dn.Resize(, Lst - 17)
        Dn.Value = Join(Application.Index(R, 0, 0), "; ")
        Dn.Offset(, 1).Resize(, Lst - 18).ClearContents
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
Application.ScreenUpdating = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Fluff]

How about

    With Worksheet
        For i = 2 To 20
            lCol = .Cells(i, .Columns.Count).End(xlToLeft).Column
            If lCol > 19 Then 'there are notes
                .Cells(i, 18) = Join(Application.Index(.Range(.Cells(i, 18), .Cells(i, lCol)).Value, 1, 0), ";")
            End If
        Next i
    End With

 

[JoeMo]

In case there are some empty columns between 18 and the last column, this will remove mutiple delimiters (;;; ...) in the R column result.

Sub ConcatIf()
Dim i As Long, lR As Long, lC As Long
lR = Cells(Rows.Count, "R").End(xlUp).Row
For i = 2 To lR
    lcol = Cells(i, Columns.Count).End(xlToLeft).Column
    If lcol > 18 Then
        Cells(i, "R").Value = Join(Application.Index(Range(Cells(i, "R"), Cells(i, lcol)).Value, 1, 0), " ")
        Cells(i, "R").Value = Replace(Application.Trim(Cells(i, "R").Value), " ", ";")
    End If
Next i
End Sub

 

[sadboy309]

This Row I can't understand: "if .cells( row, 18) is the last column in that row with data than .cells( row, 18) remains unchanged". So, the code as same as:

With ActiveSheet
    lrow = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = 2 To lrow
        lcol = .Cells(i, .Columns.Count).End(xlToLeft).Column
        If lcol = 18 Then
            If .Cells(i, lcol) > .Cells(i, 18) Then
                '...
            End If
        ElseIf lcol = 19 Then
            .Cells(i, 18) = .Cells(i, 18) & "; " & .Cells(i, 19)
        ElseIf lcol = 22 Then
            For j = 18 To 22
            .Cells(i, 18) = .Cells(i, 18) & "; " & .Cells(i, j)
            Next
        End If
    Next
End With

 

[Ark68]

Try this:-

Regards Mick

I've substituted my idea with your's Mick as a start,

   With ws_schedule
        Set rng = Range("A2").CurrentRegion
        For Each Dn In Rgn.Columns(18).Cells
            lst = Cells(Dn.Row, Columns.Count).End(xlToLeft).Column
            If Dn.Offset(, 1) <> "" Then
                R = Dn.Resize(, lst - 17)
                Dn.Value = Join(Application.Index(R, 0, 0), "; ")
                Dn.Offset(, 1).Resize(, lst - 18).ClearContents
            End If
        Next Dn
    End With

The line in red leaves me with error "Object required."

 

[MARK858]

The line in red leaves me with error "Object required."

Try spelling rng correctly?

        Set [B]rng[/B] = Range("A2").CurrentRegion
        For Each Dn In [B]Rgn[/B].Columns(18).Cells

And have you tried testing the codes as written people have posted for you?

 

[Ark68]

Try spelling rng correctly?

Thank you.

]And have you tried testing the codes as written people have posted for you?

No. Not yet. Can I try one at a time as a learning opportunity?

 

[MARK858]

No. Not yet. Can I try one at a time as a learning opportunity?

However you want but it would be nice to let the posters know if the codes worked after they have written them for you

 

[Ark68]

And I will when I have a chance to test them.