Vba Excel - concatenate cell value and loop to all columns

Question

I need help.

In a sheet I need concatenate with a loop the columns "a" + "b" + "c", next the columns "d" + "e" + "f", etc ... an go up to the last column.

My script is locked to the second loop...

The concatenated results are to appear in a second sheet.

this is my incorrect code:

Sub concatena()

Dim x As String
Dim Y As String

b = 1 'colonna selezionata

For c = 1 To 5 'colonne concatenate da riportare
For q = 1 To 10 'righe su cui effettuare l'operazione
For t = 1 To 3  'numero celle da concatenare

For Each cell In Worksheets(1).Cells(q, t) 
If cell.Value = "" Then GoTo Line1 
x = x & cell(1, b).Value & "" & ""

Next
Next t  
Line1:
On Error GoTo Terminate
Worksheets(2).Cells(q, c).Value = Mid(x, 1, Len(x))
x = ""  'mantiene la formattazione
Next q 
b = 3 + 1 ' sposta il concatena di 3 celle la selezione delle colonne
Next c

Terminate: 'error handler
End Sub

Thank you all for the help!

Do you need a VBA solution? This could be a quick formula on a separate sheet, if that is okay? — BruceWayne
– BruceWayne, Commented Sep 27, 2016 at 20:15
The problem with your code is in the line b = 3+1. It should be b=3+b. The answers will likely do what you want, and faster, but this is the error in your code. — OpiesDad
– OpiesDad, Commented Sep 27, 2016 at 20:32
By the way, the best way to figure out what is going wrong is to step through the code. Know what you expect each variable to be and keep checking to see what it is. This will show you where the error is. — OpiesDad
– OpiesDad, Commented Sep 27, 2016 at 20:34

Scott Craner · Accepted Answer · 2016-09-27 20:32:00Z

1

This one uses arrays to speed it up a little:

Sub concatena()
Dim inArr() As Variant
Dim oArr() As Variant
Dim i&, j&
Dim ws As Worksheet
Dim rng As Range

Set ws = Worksheets("Sheet9") ' change to your worksheet
With ws
    Set rng = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(1, .Columns.Count).End(xlToLeft).Column))
    inArr = rng.Value
    ReDim oArr(1 To UBound(inArr, 1), 1 To UBound(inArr, 2) / 3)
    For i = LBound(inArr, 1) To UBound(inArr, 1)
        For j = LBound(inArr, 2) To UBound(inArr, 2) Step 3
            oArr(i, Int((j - 1) / 3) + 1) = inArr(i, j) & inArr(i, j + 1) & inArr(i, j + 2)
        Next j
    Next i
    rng.Clear
    .Range("A1").Resize(UBound(oArr, 1), UBound(oArr, 2)).Value = oArr
End With

answered Sep 27, 2016 at 20:32

Scott Craner

154k10 gold badges52 silver badges88 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

Rufi0 Over a year ago

use the array in vba generates much confusion in my mind. but I must admit that are essential to program in vba. Your code is really great, thanks a lot !!

user3598756 · Accepted Answer · 2016-09-27 20:31:18Z

you can try this code:

Option Explicit

Sub concatena()
    Dim iRow As Long, iCol As Long, iCol2 As Long
    Dim arr As Variant

    With Worksheets("numbers")
        With .Cells(1, 1).CurrentRegion
            ReDim arr(1 To .Rows.Count, 1 To .Columns.Count / 3 + .Columns.Count Mod 3)
            For iRow = 1 To .Rows.Count
                iCol2 = 1
                For iCol = 1 To .Columns.Count Step 3
                    arr(iRow, iCol2) = Join(Application.Transpose(Application.Transpose(.Cells(iRow, iCol).Resize(, 3).Value)), "")
                    iCol2 = iCol2 + 1
                Next iCol
            Next iRow
            Worksheets("results").Range("A1").Resize(.Rows.Count, UBound(arr, 2)).Value = arr
        End With
    End With
End Sub

EEM · Accepted Answer · 2016-09-27 21:19:02Z

This solution provides flexibility as it uses the variable bClls to hold the number of cells to be concatenated. Assuming the source range is B2:M16 and you want to concatenate the value of every 3 cells for each row. It avoids the use of redim.

Sub Range_Concatenate_Cells_TEST()
Dim rSel As Range
Dim bClls As Byte
Dim rCllOut As Range
    bClls = 3 'change as required
    Set rSel = ThisWorkbook.Sheets("Sht(0)").Range("B2:M16") 'change as required
    Set rCllOut = ThisWorkbook.Sheets("Sht(1)").Cells(2, 2) 'change as required
    Call Range_Concatenate_Cells(bClls, rSel, rCllOut)
    End Sub

Sub Range_Concatenate_Cells(bClls As Byte, rSel As Range, rCllOut As Range)
Dim lRow As Long, iCol As Integer
Dim lRowOut As Long, iColOut As Integer
Dim vResult As Variant
    With rSel
        For lRow = 1 To .Rows.Count
            lRowOut = 1 + lRowOut
            iColOut = 0
            For iCol = 1 To .Columns.Count Step 3
                iColOut = 1 + iColOut
                vResult = .Cells(lRow, iCol).Resize(1, 3).Value2
                vResult = WorksheetFunction.Index(vResult, 0, 0)
                vResult = Join(vResult, "")
                rCllOut.Offset(-1 + lRowOut, -1 + iColOut).Value = vResult
    Next: Next: End With
    End Sub

Collectives™ on Stack Overflow

Vba Excel - concatenate cell value and loop to all columns

3 Answers 3

1 Comment

Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

1 Comment

Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related