Macro to concatenate cells in excel 1

[jupops]

Hi, can anybody help.

I need a little help to concatenate cells until you reach a blank row. For example:

1A = TO 1B = DA 1C = Y 1D = IS
2A = MO 2B = ND 2C = DA 2D = Y

so when the macro is run the cells would read

TODAY IS
MONDAY

I have used the concatenate formula and autofilled down, but was hoping for a little help to tidy this up

Thank you in advanced for any guidence

Jupops

 

[AnotherHiggins]

First, I assume that C1 is actually "Y " (with a space after the "Y")? Otherwise there's no way for Excel to know to put a space there.

And, FYI, cells are referred to by column first, then row - so it's C1, not 1C.

I happen to have something around that I wrote a while back that should work for you. To use it, just select the first column of cells that you want to combine. In your example, you would select A1:B1. NOTE: you do NOT need to select the rest of the columns that you want combined.

Sub CombineSelectedCells_Horizontally()
'***************************************************************************************
'   Written By:     AnotherHiggins
'   Written On:     2007-08-12
'   Purpose:        Combine selected cells with all populated cells to the right of them
'***************************************************************************************

    Dim strMsgPrompt                              As String
    Dim strMsgTitle                               As String
    Dim strInputPrompt                            As String
    Dim strInputTitle                             As String
    Dim MyResponse
    Dim strMyDelimiter                            As String
    Dim dblTtlRows                                As Double
    Dim dblTtlCols                                As Double
    Dim dblLstCol                                 As Double
    Dim dblActvCol                                As Double

    '   Strings for prompts
    '*****************************************************
    strMsgPrompt = Chr(9) & "This action cannot be undone!" & _
            Chr(10) & _
            Chr(10) & "You are about to combine cells in all selected rows." & _
            Chr(10) & _
            Chr(10) & "Are you sure you want to continue?"
    strMsgTitle = "Combine Cells Alert!"
    strInputPrompt = "Please type in what character(s), if any," & _
            Chr(10) & "you would like inserted between cell values." & _
            Chr(10) & "A popular choice is a comma followed by a space ("", "")" & _
            Chr(10) & _
            Chr(10) & "If you do not want any text inserted," & _
            Chr(10) & "you can just leave the box empty."
    strInputTitle = "Delimiter Input"

    '   Ask user to confirm before proceeding
    '*****************************************************
    MyResponse = MsgBox(strMsgPrompt, vbYesNo + vbDefaultButton2, strMsgTitle)

    If MyResponse = vbNo Then GoTo AnsweredNo

    '   Ask user for a delimiter
    '*****************************************************
    strMyDelimiter = InputBox(strInputPrompt, strInputTitle)

    '   Find column information
    '*****************************************************
    dblTtlRows = ActiveSheet.Rows.Count
    dblTtlCols = ActiveSheet.Columns.Count

    dblLstCol = Cells.Find( _
            What:="*", _
            After:=Cells(dblTtlRows, dblTtlCols), _
            LookIn:=xlValues, _
            SearchOrder:=xlByColumns, _
            SearchDirection:=xlPrevious).Column
    dblActvCol = ActiveCell.Column

    '   Disable screen updating to eliminate flicker
    '*****************************************************
    Application.ScreenUpdating = False

    '   Combine cell-contents horizontally for selection
    '*****************************************************[highlight]
    For Each rCell In Selection
        For i = 1 To dblLstCol - dblActvCol
            rCell.Value = rCell.Value & strMyDelimiter & rCell.Offset(, i).Value
            rCell.Offset(, i).Clear
        Next i
    Next rCell[/highlight]

    '   Get rid of any leading or trailing spaces
    '   as well as duplicated spaces within text
    '*****************************************************
    Selection.Value = Application.Trim(Selection.Value)

    Application.ScreenUpdating = True

AnsweredNo:
End Sub

I've highlighted the part that actually does the combining.

A brief walkthrough:
- The code starts by popping up a message box asking for confirmation before proceeding.

- Then it asks for a delimiter. You could create a list separated by a comma and space, for example. For your purposes, just leave this blank and press [Enter].

- Then it combines the selected cells with whatever is to the right of them.

- The TRIM function will eliminate leading and trailing spaces as well as duplicated spaces within the text (converts " hello world " to "hello world").

[tt][blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ 181-2886 before posting.

 

[jupops]

Good Morning John

This code is great (and also very instructive), but just one more quick question. can it carry to the next row automaticallt, combinding the cells until it reaches a blank row, because the Files that are sent to me often go down 1700 rows,

Regards

Jupops

 

[AnotherHiggins]

It is built to do exactly that.

To use it, just select the first column of cells that you want to combine. In your example, you would select A1:B1.

So if you have 1724 rows of data, select A1:A1724 and run the code.

[tt][blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ 181-2886 before posting.

 

[jupops]

Good Afternoon AnotherHiggins

When I keep running the code I keep getting the error code Type mismatch, but when I have typed in fresh data into another sheet it does exactly what you said,, so it is a problem with my data, I will try and see what it does not like.

Thank you for your help

Regards

Jupops

 

[SkipVought]

...I keep getting the error code Type mismatch...

on what statement?

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]