Concatenate using loop from Activecell to Lastrow

[Andresuru]

Hi Team,

Hopefully you can help me

I am trying to concatenate cells from activecell to lastrow but the thing is VBA code "LastRow" go to the last cell with data and there are some cells as empty between them so I leave an image about my expectation in green and yellow highlited is the one that is working with my VBA Code Below.

Sub Concatenate()

Lastrow = Worksheets("Data").Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row

Dim Result As String
Dim sepr As String
Dim b As String

sepr = "-"

Worksheets("Data").Select


For i = ActiveCell.Row To Lastrow

b = Cells(i, ActiveCell.Column).Value
Result = Result & b & sepr

Next i

Result = Left(Result, Len(Result) - Len(sepr))


ActiveCell.Offset(0, 1).Value = Result


End Sub

Appreciate your response

 

[Marc L]

Hi,​

​

why using 'Lastrow' is you need to stop on row #4 ? Or your picture is not accurate !​

​

Better is to attach a sample with expected results via the XL2BB tool or better on a files host website …​

 

[Alex Blakenburg]

See if this does what you want.

Sub Concatenate_Mod()
        
    Dim Result As String
    Dim sepr As String
    Dim currRow As Long
    Dim currValue As String
    Dim LastRow As Long
    
    LastRow = ActiveSheet.Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row
    
    sepr = "-"
    currRow = ActiveCell.Row
    currValue = Cells(currRow, ActiveCell.Column).Value
    
    Do While currValue <> "" And currRow <= LastRow
    
        Result = Result & currValue & sepr
        currRow = currRow + 1
        currValue = Cells(currRow, ActiveCell.Column).Value
    
    Loop
    
    If Result <> "" Then
        Result = Left(Result, Len(Result) - Len(sepr))
    End If
    
    ActiveCell.Offset(0, 1).Value = Result

End Sub

 

[Marc L]

According to the evasive initial post differents ways are possible leading to different results, one of them :​

Sub Demo1()
          Dim S$(), R&
    With ActiveSheet.UsedRange.Columns(1).SpecialCells(2).Areas
        ReDim S(1 To .Count, 0)
        For R = 1 To .Count:  S(R, 0) = Join$(Application.Transpose(.Item(R)), "-"):  Next
         [B1].Resize(.Count).Value2 = S
    End With
End Sub

 

[Marc L]

Another VBA demonstration :​

Sub Demo2()
         Dim Ra As Range
         Application.ScreenUpdating = False
    For Each Ra In ActiveSheet.UsedRange.Columns(1).SpecialCells(2).Areas
             Ra(1, 2).Value2 = Join(Application.Transpose(Ra), "-")
    Next
         Application.ScreenUpdating = True
End Sub

 

[Andresuru]

See if this does what you want.

Sub Concatenate_Mod()
       
    Dim Result As String
    Dim sepr As String
    Dim currRow As Long
    Dim currValue As String
    Dim LastRow As Long
   
    LastRow = ActiveSheet.Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row
   
    sepr = "-"
    currRow = ActiveCell.Row
    currValue = Cells(currRow, ActiveCell.Column).Value
   
    Do While currValue <> "" And currRow <= LastRow
   
        Result = Result & currValue & sepr
        currRow = currRow + 1
        currValue = Cells(currRow, ActiveCell.Column).Value
   
    Loop
   
    If Result <> "" Then
        Result = Left(Result, Len(Result) - Len(sepr))
    End If
   
    ActiveCell.Offset(0, 1).Value = Result

End Sub

Thank you a lot this is the solution I was looking for.

 

[Andresuru]

Hi,​

​

why using 'Lastrow' is you need to stop on row #4 ? Or your picture is not accurate !​

​

Better is to attach a sample with expected results via the XL2BB tool or better on a files host website …​

Basically Because the VBA code needs to be Dinamic, It wont stop always in row 4 , it needs to stop on the last row while the cell have values.

Thanks for the help

 

[Marc L]

​

But LastRow is useless here as just checking for an empty cell is enough, your initial post is so confusing …​

 

[Rick Rothstein]

Unless I am missing something, the following compact macro appears to do what Alex's code does but without using a loop...

Sub Concatenate_Mod_2()
  With ActiveCell.CurrentRegion
    .Cells(1).Offset(, 1) = Join(Application.Transpose(.Value), "-")
  End With
End Sub

 

[Peter_SSs]

Unless I am missing something,

I think that you are missing a couple of things.

Suppose A2 is selected and B1 contains the heading as shown in post 1 then your code errors.

But suppose there is nothing in column B and A3 is the active cell, your code does not do

concatenate cells from activecell ..

My suggestion is

Sub ActToLast()
  Const sepr As String = "-"
  
  With ActiveCell
    .Offset(, 1).Value = IIf(IsEmpty(.Offset(1).Value), .Value, Join(Application.Transpose(Range(.Address, .End(xlDown)).Value), sepr))
  End With
End Sub