Trying to Concatenate 2 Columns from the Table Directly VBA

Question

I have been trying to Concatenate two Columns directly from the Table1. But i really do not know how. I have tried and make below code.

But I have been creating first 2 helping Column in in "DI" and "DJ" to make this thing work.

I do not want to use these two helping columns directly wants the concatenate result in "DK2"

All help will be appreciaed.

Dim O As String
Dim P As String

O = "Milestone"
P = "Task"
    
    Sheet1.Range("Table1[" & O & "]").Copy
    Sheet2.Range("DI2").PasteSpecial xlPasteValues
    Sheet1.Range("Table1[" & P & "]").Copy
    Sheet2.Range("DJ2").PasteSpecial xlPasteValues

For i = 2 To Cells(Rows.Count, "DH").End(xlUp).Row
    Sheet2.Cells(i, "DK").Value = Sheet2.Cells(i, "DI").Value & "" & Sheet2.Cells(i, "DJ").Value
Next i

Here is the example Picture

Answer 1

EDIT: I've seen @norie's answer and it is simpler and more efficient than mine. I'll keep my answer here for anyone who is curious, but I recommend using his solution.

---

The trick is to use =INDEX(YOUR_TABLE[YOUR_COLUMN]], YOUR_ROW_STARTING_FROM_1) in order to obtain the cell contents that you needed.

Here you are your code edited:

Original

Dim O As String
Dim P As String
Dim i As Integer

O = "Milestone"
P = "Task"

For i = 1 To Application.Evaluate("ROWS(Table1[" & O & "])")
    Sheet2.Cells(i, "DK").Value = Application.Evaluate("INDEX(Table1[" & O & "], " & i & ") & INDEX(Table1[" & P & "], " & i & ")")
Next i

Optimized

Dim O As String
Dim P As String
Dim i As Integer
    
O = "Milestone"
P = "Task"

' Disable formula recalculation while trying to add our data to increase performance
Application.Calculation = xlManual
' Disable screen updating while trying to add our data to improve performance
Application.ScreenUpdating = False
For i = 1 To Application.Evaluate("ROWS(Table1[" & O & "])")
    Sheet2.Cells(i, "DK").Value = Application.Evaluate("INDEX(Table1[" & O & "], " & i & ") & INDEX(Table1[" & P & "], " & i & ")")
Next i

' Enable again formula's automatic evaluation.
Application.Calculation = xlAutomatic
' Enable again screen updating
Application.ScreenUpdating = True

Optimized using only Formulas (this performs better that the others)

Dim O As String
Dim P As String
Dim i As Integer
    
O = "Milestone"
P = "Task"

' Disable formula recalculation while trying to add our data to increase performance
Application.Calculation = xlManual
' Disable screen updating while trying to add our data to improve performance
Application.ScreenUpdating = False
For i = 1 To Application.Evaluate("ROWS(Table1[" & O & "])")
    Sheet2.Cells(i, "DK").FormulaR1C1 = "=INDEX(Table1[" & O & "], " & i & ") & INDEX(Table1[" & P & "], " & i & ")"
Next i

' Enable again formula's automatic evaluation. 
Application.Calculation = xlAutomatic
' Enable again screen updating
Application.ScreenUpdating = True

Optimized using Formulas and then converting back to values

Dim O As String
Dim P As String
Dim i As Integer
    
O = "Milestone"
P = "Task"

' Disable formula recalculation while trying to add our data to increase performance
Application.Calculation = xlManual
' Disable screen updating while trying to add our data to improve performance
Application.ScreenUpdating = False
For i = 1 To Application.Evaluate("ROWS(Table1[" & O & "])")
    Sheet2.Cells(i, "DK").FormulaR1C1 = "=INDEX(Table1[" & O & "], " & i & ") & INDEX(Table1[" & P & "], " & i & ")"
Next i

' Enable again formula's automatic evaluation. 
Application.Calculation = xlAutomatic
' Enable again screen updating
Application.ScreenUpdating = True

' Convert from formulas to values
Range("DK:DK").Copy
Range("DK:DK").PasteSpecial xlPasteValues

Answer 2

Concatenate List Columns

• With your amount of data both solutions may seem equally efficient. I've tested it with a million rows of random numbers from 1 to 1000, and the first solution took about 3.5 seconds, while the second took about 5.5 seconds on my machine. The first solution is just a more elaborate version of norie's answer.
• In this solution, you can add more columns (headers) and use a delimiter. While adding more columns the difference in the efficiencies will become more apparent, while when adding more characters to the delimiter, the efficiencies will decrease seemingly equally.

The Code

Option Explicit

Sub concatListColumnsEvaluate()
    Dim dTime As Double: dTime = Timer
    
    ' Define constants.
    Const TableName As String = "Table1"
    Const HeadersList As String = "Milestone,Task"
    Const dFirst As String = "D2"
    Const Delimiter As String = ""
    
    ' Determine table rows count.
    Dim rCount As Long: rCount = Sheet1.ListObjects(TableName).ListRows.Count
    
    ' Create Evaluate Expression String.
    Dim Headers() As String: Headers = Split(HeadersList, ",")
    Dim tUpper As Long: tUpper = UBound(Headers)
    Dim evString As String
    Dim t As Long
    If Len(Delimiter) = 0 Then
        For t = 0 To tUpper
            evString = evString & TableName & "[" & Headers(t) & "]" & "&"
        Next t
        evString = Left(evString, Len(evString) - 1)
    Else
        For t = 0 To tUpper
            evString = evString & TableName & "[" & Headers(t) & "]" & "&""" _
                & Delimiter & """&"
        Next t
        evString = Left(evString, Len(evString) - Len(Delimiter) - 4)
    End If
    
    ' Write values to Destination Range.
    Sheet2.Range(dFirst).Resize(rCount).Value = Application.Evaluate(evString)
    
    Debug.Print Timer - dTime
End Sub

Sub concatListColumnsArrays()
    Dim dTime As Double: dTime = Timer
    
    ' Define constants.
    Const TableName As String = "Table1"
    Const HeadersList As String = "Milestone,Task"
    Const dFirst As String = "D2"
    Const Delimiter As String = ""
    
    ' Write values from list columns to arrays of Data Array.
    Dim Headers() As String: Headers = Split(HeadersList, ",")
    Dim tUpper As Long: tUpper = UBound(Headers)
    Dim Data As Variant: ReDim Data(0 To tUpper)
    Dim t As Long
    For t = 0 To tUpper
        ' Either...
        Data(t) = Sheet1.Range(TableName & "[" & Headers(t) & "]").Value
        ' ... or:
        'Data(t) = Sheet1.ListObjects(TableName) _
            .ListColumns(Headers(t)).DataBodyRange.Value
    Next t
    
    ' Concatenate values of arrays of Data Array in Result Array.
    Dim rCount As Long: rCount = UBound(Data(0), 1)
    Dim Result As Variant: ReDim Result(1 To rCount, 1 To 1)
    Dim r As Long
    If Len(Delimiter) = 0 Then
        For r = 1 To rCount
            For t = 0 To tUpper
                Result(r, 1) = Result(r, 1) & Data(t)(r, 1)
            Next t
        Next r
    Else
        For r = 1 To rCount
            For t = 0 To tUpper
                Result(r, 1) = Result(r, 1) & Data(t)(r, 1) & Delimiter
            Next t
            Result(r, 1) = Left(Result(r, 1), Len(Result(r, 1)) _
                - Len(Delimiter))
        Next r
    End If
    
    ' Write values from Result Array to Destination Range.
    Sheet2.Range(dFirst).Resize(rCount).Value = Result
    
    Debug.Print Timer - dTime
End Sub

Answer 3

This can be done directly in the worksheet by using the Index function

Reference first cell in the table: =INDEX(Table1,1,1)

Concatenate cell 1 and 2 values: =INDEX(Table1,1,1)&INDEX(Table1,1,2)

It gets slightly more complicated if you want to be able to copy formulae across or down as you need to reference the current cell location

Reference first cell in the table using offsets: =INDEX(Table1,ROW()-X,COLUMN()-Y) where X, Y (minus data location offsets) are the numerical row/column of the cell where you have placed the formula.

• i.e. if placing the formula in E2 to reference Table1 cell(1,1) => =INDEX(Table1,ROW()-1,COLUMN()-4)

• where Column E=> Offset 4, Row 2 => Offset 1

• or: =INDEX(Table1,ROW()-ROW($E$2)+1,COLUMN()-COLUMN($E$2)+1)

You can now autofill the formula down or across

Answer 4

Try this.

Range("DK2").Resize(Sheet2.ListObjects("Table1").ListRows.Count) = Application.Evaluate("Table1[Milestone]&Table1[Task]")