Concatenate data when copying/creating new worksheet

[keiranwyllie]

G'Day Excel gurus, please help.

I'm hoping to be able to concatenate the data in column 'A' and 'C' into column 'A' on the same row in a new worksheet using vba.
It also needs to work it's way down the column and ignore any blank cells until a certain value ('END') in a cell is reached. It looks like the concatenate function still copies the blank cell and inserts it as a new line in the cell which I'd prefer not to have.

Hopefully the doc will download from this link - https://www.dropbox.com/s/w0wmyhstnlfs4pk/concatenate.xlsx?dl=0

Kind Regards.

 

[mumps]

I'm not sure what the final format in Sheet2 will be but try this macro. Make sure the a sheet named "Sheet2" exists.\

Sub ConcatCells()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet1").Range("C:C").Find("END", LookIn:=xlValues, lookat:=xlWhole).Row - 1
    Dim rng As Range
    For Each rng In Sheets("Sheet1").Range("C4:C" & LastRow)
        If rng <> "" Then
            Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = rng.Offset(0, -2) & Chr(10) & rng
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[keiranwyllie]

Thanks for replying so quickly.

This is so close to what I'm after however I need some minor tweaks. I changed the code to look at the activesheet because of the location that I can run the code from, as below.

Sub ConcatCells()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = ActiveSheet.Range("C:C").Find("END", LookIn:=xlValues, lookat:=xlWhole).Row - 1
    Dim rng As Range
    For Each rng In ActiveSheet.Range("C5:C" & LastRow)
        If rng <> "" Then
             ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = rng.Offset(0, -2) & Chr(10) & rng
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

That code concatentes the data I'm after which is great. Unfortunately it copies it many rows below. Eg, if I have data in cell C5, it should concatenate into cell A5. When I run the code above though, it copies it into cell A50 instead which is not desirable. I hope that makes sense.

 

[mumps]

Try:

Sub ConcatCells()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = ActiveSheet.Range("C:C").Find("END", LookIn:=xlValues, lookat:=xlWhole).Row - 1
    Dim rng As Range
    For Each rng In ActiveSheet.Range("C4:C" & LastRow)
        If rng <> "" Then
             ActiveSheet.Range("A" & rng.Row) = rng.Offset(0, -2) & Chr(10) & rng
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[keiranwyllie]

Thanks mate, this worked as requested.

I also run a macro that copies the current worksheet to a new day (which calls the concatcells macro above). I've noticed some odd behaviour though, in that it randomly truncates text in the cells during the copy. Any idea why this may happen? I can provide the code if req'd, just thought it may have occured to someone before.

 

[mumps]

Unless you exceed the maximum number of characters for a cell (32767), I don't know why some text is truncated. Perhaps you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of the problem referring to specific cells and worksheets. If the workbook contains confidential information, you could replace it with generic data.

 

[keiranwyllie]

I worked it out. Turns out some clients are still using good ol' Office 2003. Truncates to 255 characters per cell. Gotta get with the times.

Thanks again.

 

[mumps]

You are very welcome.