vba to concatenate split scattered data in a single cell

[RAM72]

Hi All

I have an issue that data is scattered all of the neighbouring cells , need a code to concatenate all in single cell

See attached

 

[Luke M]

How do we know which data goes where? E.g., B23 in first sheets gets matched up to...B19? Why?

 

[RAM72]

How do we know which data goes where? E.g., B23 in first sheets gets matched up to...B19? Why?

Well the data below always corresponds to the data of the the cell up.

 

[Luke M]

Then your example isn't correct.


became this


Please double-check and provide a better example? I know it may make perfect sense to you, but to us, the placement/words mean nothing. We'll need cell references and logic rules to understand what you want.

 

[RAM72]

Then your example isn't correct.
View attachment 32814

became this
View attachment 32815

Please double-check and provide a better example? I know it may make perfect sense to you, but to us, the placement/words mean nothing. We'll need cell references and logic rules to understand what you want.

oops sorry for this mislead example

See revise if you need further info , what i mean I recieved the data scatered like this, I need to concatenate all this data , I know It is not easy but I got this issue with description header and code bar headers

 

[Luke M]

Try this. Macro assumes that all the main categories that will go into col A are 2 rows apart.

 

[Marc L]

Hi !

Another way :​

Sub Demo()
    Const S = " "
    Dim L&, R&, U&, V
    L = 1
    R = 1
    V = Sheet1.UsedRange.Value
    U = UBound(V)
    ReDim W(1 To U \ 2, 1 To 2)
    W(1, 1) = V(1, 1):  W(1, 2) = V(1, 2)
While R < U
            R = R + 1
    If V(R, 2) > "" Then
            L = L + 1
      W(L, 1) = V(R, 1)
      If R < U Then W(L, 2) = V(R, 2) & S & V(R + 1, 1) & S & V(R + 1, 2) & S & V(R + 1, 3) Else W(L, 2) = V(R, 2)
            R = R + 1
    End If
Wend
    With Sheet2.[A1:B1].Resize(L).Columns
        .Parent.UsedRange.Clear
        .Item(1).NumberFormat = "0"
        .Value = W
        .AutoFit
        Application.Goto .Cells(1), True
    End With
End Sub

Do you like it ? So thanks to click on bottom right Like !
​