Concatenate

I need to Concatenate Values in Column A with Corresponding values in Columns B to XW and result pasted in another sheet, can someone help me as to how I can do this in VBA with a loop macro.

Expert Asked on September 17, 2018 in VBA: Macros.
Add Comment
4 Answer(s)

To be honest, I not sure I understand your question. Below is my understand of what I think you need.

In this example we will need 3 sheets named sheet1, sheet2, and sheet3. You can change the name to suit your needs inside the macro.

We will concatenate row 1 Range A1:XW1 on Sheet1. The concatenated data will reside on sheet3.

Sheet 1 is the raw data in cells A1:XW5 as shown.

Sheet 2 is used to transpose the data to columns, leave it blank – No Data

Sheet 3 will contain the results

 

RE: Concatenate

.


Sub Trial_1_Click()

'Copy all data from sheet 1 to sheet 2 and transpose

Sheets("Sheet1").Activate

Range("A1").Select

ActiveCell.CurrentRegion.Copy

With Sheet2

.[a1].PasteSpecial Paste:=xlPasteValues, Transpose:=True

End With
'Sheet 2 data

Sheets("Sheet2").Activate

Dim c As Integer

Dim r As Integer

Dim lastcol As Integer

Dim i As Integer

Dim lr As Long

Dim col As Integer
lastcol = Sheets("Sheet2").Cells(1, Columns.Count).End(xlToLeft).Column

c = 1

r = 1

Cells(1, c).Select

col = 1
For i = 1 To lastcol

lr = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row

Select Case lr - ActiveCell.Row

Case 0: Sheets("Sheet3").Range("A" & col).Value = ActiveCell.Value

Case Is < 0: Sheets("Sheet3").Range("A" & col).ClearContents

Case Else: Sheets("Sheet3").Range("A" & col).Value = Join(Application.Transpose(Range(ActiveCell, Cells(lr, ActiveCell.Column))), "")

End Select

r = r + 1

col = col + 1

ActiveCell.Offset(0, 1).Select

Next i

[a1].Select

ActiveCell.CurrentRegion.ClearContents

Sheets("Sheet3").Activate
End Sub

 

Good luck this was a challenge question. Please note that the core code for this I did not write, but copied from

https://www.mrexcel.com/forum/excel-questions/930696-vba-concatenate-dynamic-range-row-row.html

RE: Concatenate

Expert Answered on September 20, 2018.
Add Comment

Hey Thank you so much. Apologies for not been very clear on the question. Using your example, in the output I want A1 &B1, A1&C1, A1&D1 and the complete series till blank row, output getting pasted in a separate sheet.

Expert Answered on September 20, 2018.

Okay, I will check on it again and see what I can come up with for you.

on September 20, 2018.
Add Comment

Lets try this again.  You will need 3 sheets. Sheet1, Sheet 2 and Sheet3

Sheet1 your raw data

Sheet2 is a work sheet is should be empty. The macro will use the sheet and then delete all contents when it is done.

Sheet3 is your results sheet.

RE: Concatenate

Sub Concat1()

Dim ws1 As Worksheet

Set ws1 = Worksheets("Sheet1")

Dim ws2 As Worksheet

Set ws2 = Worksheets("Sheet2")

Dim ws3 As Worksheet

Set ws3 = Worksheets("Sheet3")

Dim a As Range

Dim b As Range

Dim x As Integer

Dim y As Integer

Dim i As Long

Dim lrow As Long

Dim p As Long

ws1.Range("A1").CurrentRegion.Copy

ws2.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
ws2.Select
For p = 1 To 647

lrow = Cells(Rows.Count, "A").End(xlUp).Row - 1

x = 1

y = 2

Set a = Range("A" & x)

Set b = Range("A" & y)

[XX1].Select

For i = 1 To lrow
ActiveCell = a & b

ActiveCell.Offset(1).Select

y = y + 1

Set b = Range("A" & y)

Next i
Columns("A").Delete

Next p
ws2.Range("A1").CurrentRegion.Copy

ws3.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

ws2.Range("A1").CurrentRegion.ClearContents

ws3.Columns("A:XA").AutoFit

ws3.Select

MsgBox "Done!"

End Sub

Good luck!

Hyside2

Expert Answered on September 21, 2018.
Add Comment

Updated the code to include the possibility of blank cells in the raw data. If a blank cell is found it will be filled with a zero (0)

This code is more dynamic so column XW is not the limit on columns.  Give it a try!

Sub concat()

Application.ScreenUpdating = False

Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet

Set ws1 = Worksheets("Sheet1")

Set ws2 = Worksheets("Sheet2")

Set ws3 = Worksheets("Sheet3")

On Error GoTo Line1

Range("A1").CurrentRegion.SpecialCells(xlCellTypeBlanks).Value = 0

Line1:

ws1.[A1].CurrentRegion.Copy

ws2.[A1].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

ws3.UsedRange.ClearContents
ws2.Activate

Dim lastcol As Integer

Dim lastrow As Integer

Dim i As Integer, a As Integer, b As Integer, c As Integer, d As Integer, e As Integer

Dim x As Variant

Dim lrow As Double, lstcol As Double

lrow = Application.WorksheetFunction.CountA(Columns(1)) - 1

lastcol = ws2.Cells(1, Columns.Count).End(xlToLeft).Column + 1

lstcol = ws2.Cells(1, Columns.Count).End(xlToLeft).Column

a = 1

b = 2

c = 1

e = 1

x = Cells(b, c)

For d = 1 To lstcol

For i = 1 To lrow

Cells(a, lastcol).Formula = "=A1 &" & x

a = a + 1

b = b + 1

x = Cells(b, c)

Next i

Range(Cells(1, lastcol), Cells(lrow, lastcol)).Copy

Range(Cells(1, lastcol), Cells(lrow, lastcol)).PasteSpecial Paste:=xlPasteValues

Columns("A").Delete

a = 1

b = 2

c = 1

x = Cells(b, c)

Next d

Range("A1").CurrentRegion.Copy

ws3.Range("A1").PasteSpecial Paste:=xlPasteValues, Transpose:=True

ws2.[A1].CurrentRegion.ClearContents

ws3.Select

[A1].Select

MsgBox "Finished!"

End Sub
Expert Answered on September 22, 2018.
Add Comment
  • Found this useful?

    Please share using the share button above.

    If you found the answer is best answer for your question, Please mark as 'best answer' by clicking on the right tick mark icon at the left side of the answer.

    Found the answer useful and wants to credit the user, then vote the answer (vote up).

  • Your Answer

    By posting your answer, you agree to the privacy policy and terms of service.