How to concatenate cells in a row until a specific value

Question

hi i have this data set from hell. the data when i get it would have the fields spill across columns unevenly. so there may be some rows with 3 columns, 4 columns or 5 columns

This is the data

o   o   x   y   
o   o   o   x   y
o   o   oxo y   
o   o   y

desired data cleaned up

oo  x   y
ooo x   y
oo  oxo y
o   o   y

what i attempt to do is

read row wise till detect x
concatenate all the O's on the first column
delete all the other O's so that the x and y can move to the left
sometimes the x may be wrapped in some other text
sometimes there may not even be an x at all. then i would skip on to the next row rather than loop infinite

i have searched up and down the forum, but the closest i can find to my problem is How to concatenate cells in a row until the first blank cell sadly, the final answer for where instead of a blank cell to be a specific value is not shared there.

i tried my luck with my crude skills in VBA but eh...i think i end up confusing myself more he he he

Sub x()

Dim n As Long, r1 As Range, r2 As Range, v

For n = 1 To Range("A" & Rows.Count).End(xlUp).Row
    On Error Resume Next
    Rng.SpecialCells(xlCellTypeConstants).Select

    If Not r1 = "x" And Not r2 Is Nothing Then
        v = Join(Application.Transpose(Application.Transpose(r1)), " ")

        Cells(n, 2).Resize(, r1.Count).Clear
        r2.Cut Cells(n, 3)
    End If

    ActiveCell.Offset(1, 0).Select


Next n
End Sub

` any help would very much be appreciated here

here is something I don't understand, why o oox y should be o o y (last row) while o o oxo y should be oo oxo y (second to last)? — MarcinSzaleniec
the second last line is because the x may be wrapped up in some other string, hence the loop should stop when it sees the oxo — Billtan

newacc2240 newacc2240 · Accepted Answer · 2017-11-07T09:27:19

I supposed that the last line of your data is mistyped.

My data looks like:

o   o   x   y   
o   o   o   x   y
o   o   oxo y   
o   o   y   
x   y
o   x   y

The output:

oo  x   y
ooo x   y
oo  oxo y
o   o   y
x   y   
o   x   y

Scan thru the whole row till it found x or it is blank.
Concatenate all cells before x into the first column.
If x is not found, it will skip to the next row.

Here is the code:

Sub x()
    Dim n, i As Long
    Dim r1, r2 As Range

    'For concatenating the cells
    Dim tmpString As String

    'For stopping the while loop
    Dim NextLoop As Boolean: Flag = True

    For n = 1 To Range("A" & Rows.Count).End(xlUp).Row
        'Resetting all variables
        tmpString = ""
        NextLoop = True
        i = 0
        On Error Resume Next

        'Start scanning the row from column A
        Set r1 = Range("A" & n)

        'It will stop when a blank cell is detected
        Do While r1.Offset(0, i) <> "" And NextLoop

            'Check "x" is in the cell or not
            If InStr(1, r1.Offset(0, i).Value, "x") > 0 Then

                '"x" is found, so stop the loop
                NextLoop = False
                'Set r2 pointing to the cell with "x"
                Set r2 = r1.Offset(0, i)
            Else
                '"x" is not found yet, so we add the value into tmpString
                tmpString = tmpString & r1.Offset(0, i).Value
            End If
            i = i + 1
        Loop

        'If NextLoop is true, it means "x" is not found in the row
        If Not NextLoop Then

            '"x" is found, concancate all cells into the first one
            If tmpString <> "" Then r1.Value = tmpString

            'If there are cells between r1 and r2, they should be deleted
            If r2.Column - r1.Column > 1 Then Range(r1.Offset(0, 1), r2.Offset(0, -1)).Delete xlToLeft

        End If
    Next n
End Sub

How to concatenate cells in a row until a specific value

1 Answers