Combine Selected Rows Data Horizontally But Not Vertically

[miketurn]

Hello Everyone,

I believe this will probably be one of the last I ask for in a while, hopefully
I am looking for a macro that will allow you to combine data horizontally (by columns) but NOT vertically (by rows) of single or multiple SELECTED cells in Column A.

1.) I would like to be able to do this by simply SELECTING one or more cells in Column A and the macro will know to look to the RIGHT of the selection in COLUMN A and will take any data found in that selected Column A row and will add it to the end of the data found in Column A.

2.) I would like this macro to retain the cells background fill color in Column A, meaning don't remove the fill color.

3.) I would like this macro to add a SINGLE SPACE between each piece of combined text added to the Column A row.
(See Example #1 Below)

Note:
The specific row numbers shown in the following example, are just an example, I would like this to be able to be applied to any SELECTED Column A Rows.

EXAMPLE #1
BEFORE
|____A____|____B____|____C____|
1 apple____orange____banana
2 apple____orange____banana
3 apple______________banana
4 _________orange____banana
5 apple____orange____banana
6 apple____orange__________

If you SELECT Column A's cells 2,3,4 and 6 and apply the macro you would get

AFTER
|____A____|____B____|____C____|
1 apple____orange____banana
2 apple orange banana
3 apple banana
4 orange banana
5 apple____orange____banana
6 apple orange

Notice rows 1 and 5 remain the same because they were NOT selected.

Notice in row 3 there is only a single space between apple and banana .
Notice in row 4 there is not a space at the beginning.
The handling of these two "space" issues can be achieved by adding the following links macro to this macro.

https://www.mrexcel.com/forum/excel-questions/991831-remove-extra-spaces-within-cells.html

Thank You to anyone who reads this and to anyone who provides a solution.
Any questions, please let me know.

 

[AlphaFrog]

[COLOR=darkblue]Sub[/COLOR] Concatenate_Selected_Rows()
    [COLOR=darkblue]Dim[/COLOR] arr [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant, cell as Range[/COLOR]
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] cell [COLOR=darkblue]In[/COLOR] Selection
        [COLOR=darkblue]If[/COLOR] cell.Column = 1 [COLOR=darkblue]Then[/COLOR]
            arr = Application.Transpose(Application.Transpose(Intersect(cell.EntireRow, ActiveSheet.UsedRange)))
            cell.Value = Application.Trim(Join(arr, " "))
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] cell
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

 

[Tetra201]

See if this works for you:

Sub HCombine()
    Dim TempArr()
    Dim TempRng As Range
    For i = 1 To Selection.Areas.Count
        If Selection.Areas(i).Columns.Count > 1 Then Exit Sub
    Next i
    For Each cll In Selection
        Set TempRng = Range(cll, Cells(cll.Row, Columns.Count).End(xlToLeft))
        ReDim TempArr(1 To TempRng.Count)
        If TempRng.Count > 1 Then
            TempArr = Application.Transpose(Application.Transpose(TempRng))
        Else
            TempArr(1) = TempRng
        End If
        TempRng.ClearContents
        cll.Value = WorksheetFunction.Trim(Join(TempArr))
    Next cll
End Sub

 

[Rick Rothstein]

Here is one more method to consider...

[table="width: 500"]
[tr]
	[td]Sub Concatenate_Selected_Rows()
  Dim cell As Range
  On Error GoTo NothingSelectedInColumnA
  For Each cell In Intersect(Selection, Columns("A"))
    cell = Application.Trim(Join(Application.Index(Intersect(cell.EntireRow, ActiveSheet.UsedRange).Value, 1, 0)))
  Next
NothingSelectedInColumnA:
End Sub[/td]
[/tr]
[/table]

If you are guaranteed to have at least one cell in Column A selected when you run this code, you can simplify it to this...

[table="width: 500"]
[tr]
	[td]Sub Concatenate_Selected_Rows()
  Dim cell As Range
  For Each cell In Intersect(Selection, Columns("A"))
    cell = Application.Trim(Join(Application.Index(Intersect(cell.EntireRow, ActiveSheet.UsedRange).Value, 1, 0)))
  Next
End Sub[/td]
[/tr]
[/table]

 

[miketurn]

Wow, Thank You guys for all of these.
I have tested each of these macros out and I will provide notes for each of you specifically.

@Tetra201
Wow, this works perfectly.
It even works in selected Columns other than Column A which I didn't ask for but wanted to. I figured for the most part I would always use it in Column A and didn't want to make my request more complicated to explain, but I like the option of it working in other columns as well, very nice.

@AlphaFrog
@Rick Rothstein
Not sure if it is just coincidence, or maybe my explanation, but both of your macros combine all the data into Column A correctly, but they don't seem to delete the data from the other cells to the right of the selection after doing so. It seems like in a way they copy the text to Column A, leaving the text behind in their original locations.

Again thank you guys for providing all these options, I really appreciate it.

 

[Rick Rothstein]

@AlphaFrog
@Rick Rothstein
Not sure if it is just coincidence, or maybe my explanation, but both of your macros combine all the data into Column A correctly, but they don't seem to delete the data from the other cells to the right of the selection after doing so. It seems like in a way they copy the text to Column A, leaving the text behind in their original locations.

Only one more line of code is required for the macros I posted to do this...

If it is possible that nothing is selected in Column A....

[table="width: 500"]
[tr]
	[td]Sub Concatenate_Selected_Rows()
  Dim Cell As Range
  On Error GoTo NothingSelectedInColumnA
  For Each Cell In Intersect(Selection, Columns("A"))
    Cell = Application.Trim(Join(Application.Index(Intersect(Cell.EntireRow, ActiveSheet.UsedRange).Value, 1, 0)))
    [COLOR="#0000FF"]Cell.Offset(, 1).Resize(, Columns.Count - 1).ClearContents[/COLOR]
  Next
NothingSelectedInColumnA:
End Sub[/td]
[/tr]
[/table]

If at least one cell in Column A will be guaranteed to be selected...

[table="width: 500"]
[tr]
	[td]Sub Concatenate_Selected_Rows()
  Dim Cell As Range
  For Each Cell In Intersect(Selection, Columns("A"))
    Cell = Application.Trim(Join(Application.Index(Intersect(Cell.EntireRow, ActiveSheet.UsedRange).Value, 1, 0)))
    [COLOR="#0000FF"]Cell.Offset(, 1).Resize(, Columns.Count - 1).ClearContents[/COLOR]
  Next
End Sub[/td]
[/tr]
[/table]

 

[miketurn]

@Rick Rothstein
Thank You for this update, I tested it out and it works great.

 

[miketurn]

Hey Guys,
I don't mean to re-open this thread but I just noticed something, that maybe could be altered by someone.
In other macros a line of coding is added for separators between combined cells, where you see " " which gives you the option to change what separates combined cell data.
The " " represents adding a "space" separator between each cell data combined.
The above macros add a space between, but I don't see a place where this "space" separator can be changed to something else if needed.
Would it be possible to add this option to one of the above macros found in post #3 or #6?
They both work great, but having the option to customize the separator is an added bonus, if possible.

Thank You

 

[Rick Rothstein]

In other macros a line of coding is added for separators between combined cells, where you see " " which gives you the option to change what separates combined cell data.
The " " represents adding a "space" separator between each cell data combined.
The above macros add a space between, but I don't see a place where this "space" separator can be changed to something else if needed.
Would it be possible to add this option to one of the above macros found in post #3 or #6?

As long as none of the cells contain text with a required space character in it (for example, "small banana") where the space must be maintained, [untested] you could add this line of code immediately before the Next statement for what I posted in Message #6...

Cell.Replace " ", "-", xlPart

 

[Tetra201]

... The above macros add a space between, but I don't see a place where this "space" separator can be changed to something else if needed.
Would it be possible to add this option to one of the above macros found in post #3 or #6?...

Here is a modified code:

Sub HCombine()
    Dim TempArr()
    Dim TempRng As Range
    [COLOR=#FF0000]Spacer = "-"[/COLOR]
    For i = 1 To Selection.Areas.Count
        If Selection.Areas(i).Columns.Count > 1 Then Exit Sub
    Next i
    For Each cll In Selection
        Set TempRng = Range(cll, Cells(cll.Row, Columns.Count).End(xlToLeft))
        [COLOR=#FF0000]TempRng.Replace " ", Chr(160), xlPart[/COLOR]
        ReDim TempArr(1 To TempRng.Count)
        If TempRng.Count > 1 Then
            TempArr = Application.Transpose(Application.Transpose(TempRng))
        Else
            TempArr(1) = TempRng
        End If
        TempRng.ClearContents
        cll.Value = WorksheetFunction.Trim(Join(TempArr))
    Next cll
    [COLOR=#FF0000]Selection.Replace " ", Spacer, xlPart[/COLOR]
    [COLOR=#FF0000]Selection.Replace Chr(160), " ", xlPart[/COLOR]
End Sub