CONCATENATE Each Row Into a Single Cell

[madkinson]

I have a 10,000 row spreadsheet where I need to convert each row (about 30 columns) into a single cell with a pipe ("|") separator. I've manually created a CONCATENATE statement (=CONCATENATE(A1,"|",B1,"|",C1,"|",D1,"|", ETC.), but that take way too long.

I've tried Pearson's StringConcat, but cannot get it to work. I would like to put it into VBA so I can use it on other sheets. As always, you kind assistance is greatly appreciated.

 

[Rick Rothstein]

You said about 30 columns which isn't very precise, so I gave you a variable where you can set the maximum last column number (currently set at 30). Also, you did not say where the output is supposed to go to, so I guessed Column AF (change last code line if that is wrong).

[table="width: 500"]
[tr]
	[td]Sub ConcatIndividualRows()
  Dim R As Long, C As Long, MaxLastCol As Long
  Dim Data As Variant, Results As Variant
  MaxLastCol = 30
  Data = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Resize(, MaxLastCol)
  ReDim Results(1 To UBound(Data), 1 To 1)
  For R = 1 To UBound(Data)
    For C = 1 To MaxLastCol
      Results(R, 1) = Results(R, 1) & IIf(Right(Results(R, 1), 1) = "|", "", "|") & Data(R, C)
    Next
    Results(R, 1) = Mid(Results(R, 1), 2)
    If Right(Results(R, 1), 1) = "|" Then Results(R, 1) = Left(Results(R, 1), Len(Results(R, 1)) - 1)
  Next
  Range("AF1").Resize(UBound(Results)) = Results
End Sub[/td]
[/tr]
[/table]

 

[DocAElstein]

. Another version.
. It does not nicely take off excess |’s like Rick’s, so assumes all columns are full or else you get ||| etc.
. ( I did have another code version that could be very fast, but it will not work with so many columns as you have )
. (I put the output in AF also )

Sub MadkinsonConcastabastes() '---o00o---`(_)`---o00o---
'  http://www.excelfox.com/forum/f17/appendix-thread-codes-for-other-threads-html-tables-etc-2056/#post9506
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Worksheets("Sheet1") 'Sheet Info
Dim lr As Long: Let lr = ws1.Cells(Rows.Count, 1).End(xlUp).Row
Dim j As Long, lc As Long: Let lc = 30 ': Let lc = ws1.Cells.Find(What:="*", After:=ws1.Cells(1, 1), lookat:=xlPart, LookIn:=xlFormulas, searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
Dim arrIn() As Variant
Dim c00 As String, c00TempJ As String, c00TempI() As Variant

'snb Bit------------------------------------------------
Let arrIn() = ws1.Range("A1", ws1.Cells(lr, lc)).Value
   For j = 1 To UBound(arrIn())
   c00TempI() = Application.Index(arrIn(), j, 0)
   c00TempJ = Join(c00TempI(), "|")
   c00 = IIf(j = 1, c00TempJ, c00 & vbLf & c00TempJ)
   Next
            'MsgBox ("" & c00 & "")
'Output---------------------------------------------
Dim arrOutS() As String: arrOutS() = Split(c00, vbLf) 'Output transposed 1D Array
Dim arroutT() As Variant: arroutT() = Application.WorksheetFunction.Transpose(arrOutS()) 'Output 2D 1 "column" Array
ws1.Columns(32).ClearContents
ws1.Range("AF1").Resize((UBound(arroutT(), 1)), 1).Value = arroutT()
End Sub

Alan




Special concatenation

 

[madkinson]

Rick, thanks! That worked perfectly. Now all I have to do is add a couple of dialog boxes so I can change the parameters for each sheet.