Loop down rows on multiple selected cells

[MadeleineB]

I have a sub that will join the text together from multiple columns into one cell but it only works for one row. I would like it to work through the rows selected. How do I do this?

Sub JoinText()

myCol = Selection.Columns.Count
For i = 1 To myCol
ActiveCell = ActiveCell.Offset(0, 0) & ActiveCell.Offset(0, i)
ActiveCell.Offset(0, i) = ""
Next i

End Sub

 

[Richard Schollar]

Hello Madeleine

Do you mean if you select A1:G100 then the joined text will be placed in A1 for row 1, A2 for row 2, A3 for row 3 etc, or do you want the text from all the cells (A1:G100) to be joined together and placed in A1?

 

[MadeleineB]

If (A1:G100) I would like the result to be:<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
A1 = cells A1 to G1<o></o>
A2 = cells A2 to G2 <o></o>
<o></o>
e.t.c.

 

[Richard Schollar]

Try this:

Sub Test()
Dim arr As Variant, i As Long, j As Long, temp, arrOut
arr = Selection.Value
ReDim arrOut(1 to UBound(arr,1),1 To 1)
For i = 1 to UBound(arr,1)
For j = 1 to UBound(arr,2)
temp = temp & arr(i,j)
Next j
arrOut(i,1) = Temp
temp = ""
Next i
Selection.ClearContents
Selection(1).Resize(Ubound(arrOut,1)).Value = arrOut
End Sub

 

[MadeleineB]

Yep that does it thanks Richard.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
Just to tweak it, is there a way to put a space between each cells text?<o></o>

 

[MadeleineB]

I worked it out:

temp = temp & " " & arr(i, j)

Thanks so much for your help.

 

[Richard Schollar]

Sure:

Sub Test()
Dim arr As Variant, i As Long, j As Long, temp, arrOut
arr = Selection.Value
ReDim arrOut(1 to UBound(arr,1),1 To 1)
For i = 1 to UBound(arr,1)
For j = 1 to UBound(arr,2)
temp = temp & " " & arr(i,j)
Next j
arrOut(i,1) = Mid(temp,2)
temp = ""
Next i
Selection.ClearContents
Selection(1).Resize(Ubound(arrOut,1)).Value = arrOut
End Sub

Aha! You got there before I did

 

[MadeleineB]

Dam, I've just be told that I need to combine columns and not rows.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
Help again please.<o></o>

 

[Richard Schollar]

Assuming if A1:G100 selected then you want the results in A1:G1 then:

Sub Test()
Dim arr As Variant, i As Long, j As Long, temp, arrOut
arr = Selection.Value
ReDim arrOut(1 To 1,1 to UBound(arr,2))
For i = 1 to UBound(arr,2)
For j = 1 to UBound(arr,1)
temp = temp & " " & arr(j,i)
Next j
arrOut(1,i) = Mid(temp,2)
temp = ""
Next i
Selection.ClearContents
Selection(1).Resize(,Ubound(arrOut,2)).Value = arrOut
End Sub

 

[MadeleineB]

Great it works a treat.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
Thanks for all your help. It has saved me doing a very tedious task manually. <o></o>