• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

How do I create macro to combine cells?

blcexcel

blcexcel

Member
I need a simple macro to combine a list of numbers (rows) into one cell separated by commas. I picture a loop that starts at the first cell and continues until there is a blank.

Thanks in advance! :)

Input:
9500
9501
9502

Output:
9500,9501,9502
 
This is one of my favorite UDFs.
Code: 
Function ConCat(Delimiter As Variant, ParamArray CellRanges() As Variant) As String
 
    Dim cell As Range, Area As Variant
 
    If IsMissing(Delimiter) Then Delimiter = ""
 
    For Each Area In CellRanges
        If TypeName(Area) = "Range" Then
            For Each cell In Area
                If Len(cell.Value) Then ConCat = ConCat & Delimiter & cell.Value
            Next
        Else
            ConCat = ConCat & Delimiter & Area
        End If
    Next
 
    ConCat = Mid(ConCat, Len(Delimiter) + 1)
End Function
You can call it from the worksheet as a formula, or in a macro. In a macro, it would be
Code: 
X = ConCat(",",Range("A1:A4"))
 
Hello Luke M. Thanks for your help. My list of numbers will often be over one hundred long so I'm definitively looking for a macro solution. Also the range of numbers will vary so I would like the range to be created dynamically. And I'm confused was the code above designed to live outside of the macro?
 
Yes, the Function would be best served by being separate from your main code. You just need to pass it a delimter and range(s) of cells that you want to concatenate. It doesn't care what size of range you feed it. :)

So, yes, it is a macro/VBA solution. The range being dynamic is a separate question from the concatenation. Taking a guess, that part of the question could be solved possible by:
Code: 
Set MyRange = Range("A2",Range("A2").End(xlDown))

Then, you just pass that range to the function, like so
Code: 
Dim X as String
X = ConCat(",",MyRange)
 
Luke M,
I may be more remedial than you are used to. I created the function and a macro with then code you have above and nothing happens. What am I doing wrong. Is there more I need to add to the macro? Do I need to change "Range" to "MyRange" in the function somewhere? I have worked in VBA but more modifying and building on to existing ones.
Brian
 
Brian,
Would you be able to post the code that you have to this forum? See my signature for the HTML tags to use when posting it. Assuming your macro is in a regular Module, it should look something like this:
Code: 
Sub MainMacro()
'This is where I do stuff
 
'Define my variables
Dim myRange As Range
Dim myString As String
 
'Set this variable to something
Set myRange = Range("A2:A10")
'or a dynamic range
Set myRange = Range("A2", Range("A2").End(xlDown))
 
'call the function and pass the output to a variable
myString = ConCat(",", myRange)
 
'Do something with that info
MsgBox myString
End Sub
 
Function ConCat(Delimiter As Variant, ParamArray CellRanges() As Variant) As String
 
    Dim cell As Range, Area As Variant
 
    If IsMissing(Delimiter) Then Delimiter = ""
 
    For Each Area In CellRanges
        If TypeName(Area) = "Range" Then
            For Each cell In Area
                If Len(cell.Value) Then ConCat = ConCat & Delimiter & cell.Value
            Next
        Else
            ConCat = ConCat & Delimiter & Area
        End If
    Next
 
    ConCat = Mid(ConCat, Len(Delimiter) + 1)
End Function
 
@Luke M
Hi, buddy!
"all pretty"... but (and as b(ut)ob(ut)hc uses to say, there's always a but...t?) not for indented comments. :(
Regards!
 
Hi Guys

I have been looking at Luke's code and it is very good IMO. I wanted to see if I could do the same thing pushing the information into a pure macro without a function. I have a few questions though. Do you want every single area within a given column? Where do you want to display the results? Do you want a list in Cell or is a messagebox OK.

With this sort of thing the best thing to do is supply a file with dummy data and show your outputs the way it should look after the procedure has run. This removes ambiguity and you get a faster result. Anyways here is my take with a workbook to show workings.

Code: 
Option Explicit
 
Sub MergEM1()
Dim r As Range
Dim str As String
 
'Loop through the used cells and combine.
  For Each r In Range("A2", Range("A2").End(xlDown))
      str = str & r.text & ", "
  Next r
MsgBox Left(str, Len(str) - 2) 'Present results cleanly
End Sub

Take it easy

Smallamn
 

Attachments

  • MergeME.xlsm
    17.3 KB · Views: 3
Hi !​
blcexcel said:
I need a simple macro to combine a list of numbers (rows) into one cell separated by commas.
I picture a loop that starts at the first cell and continues until there is a blank.
Click to expand...
So, to combine vertical cells into a one cell list, with only the first cell in argument,​
the last cell before a blank one is detected by only a one line code list function (the simplest I can do !) :​
Code: 
Function VList$(Rg As Range, Optional Delimiter$ = ",")
         VList = Join(Application.Transpose(Range(Rg(1), Rg(1).End(xlDown))), Delimiter)
End Function
 
 
Sub Demo()
    [E1].NumberFormat = "@"
           [E1].Value = VList([A1])
End Sub

In the Demo example procedure, list is in cell E1 and starts from cell A1 …​
Just note by code the destination cell must be in text format before to affect it the list function ...​
But no matter if calling it from a worksheet's formula, the code must just be inserted in a standard module.​
Formula example : =VList(A1)​
​
Like it !​
 
Just in case we are interested in a formula instead of the VBA, here is what can be done.
Assumption: Your data starts from A1 upto A10.

in B1 update the formula"=A1"
in B2 update ="B1&","&A2"

Hope this helps..:)
 
Luke M said:
Not sure what you mean...my comments appear just fine.
Click to expand...
@Luke M
Hi!

I took the last code I wrote yesterday here. 1st mode with VBA (or without language), 2nd mode with VB:
Code: 
Option Explicit
 
Sub ExpandAndPlay()
    ' constants
    Const ksWSSource = "Analyse"
    Const ksDate = "A2"
    Const kiColumnKey = 2
    Const kiColumnCalculationSource = 14
    Const ksWSTarget = "ZB "
    Const ksKey = "D2"
    Const kiColumnDate = 1
    Const kiColumnCalculationTarget = 15
    ' declarations
    Dim dDate As Date, nCalculation As Single, iKey As Integer
    Dim I As Long, J As Long
    ' start
    dDate = Worksheets(ksWSSource).Range(ksDate).Value
    ' process
    For I = 4 To Worksheets(ksWSSource).Rows.Count
        ' quit at 1st empty
        If Worksheets(ksWSSource).Cells(I, 1).Value = "" Then Exit For
        ' retrieve key
        iKey = Worksheets(ksWSSource).Cells(I, kiColumnKey).Value
        With Worksheets(ksWSTarget)
            ' put key
            .Range(ksKey).Value = iKey
            ' find row
            J = .Cells.Find(dDate, .Cells(1, kiColumnDate), xlValues, xlWhole).Row
            ' retrieve calculation
            nCalculation = .Cells(J + 1, kiColumnCalculationTarget).Value
            Worksheets(ksWSSource).Cells(I, kiColumnCalculationSource).Value = nCalculation
            ' collapse all groups
            .Outline.ShowLevels 1
            ' expand found group
            .Rows(J - 1).ShowDetail = True
            ' print
            .PrintOut , , , True
        End With
    Next I
    ' end
    Beep
End Sub
Code: 
Option Explicit
 
Sub ExpandAndPlay()
    ' constants
    Const ksWSSource = "Analyse"
    Const ksDate = "A2"
    Const kiColumnKey = 2
    Const kiColumnCalculationSource = 14
    Const ksWSTarget = "ZB "
    Const ksKey = "D2"
    Const kiColumnDate = 1
    Const kiColumnCalculationTarget = 15
    ' declarations
    Dim dDate As Date, nCalculation As Single, iKey As Integer
    Dim I As Long, J As Long
    ' start
    dDate = Worksheets(ksWSSource).Range(ksDate).Value
    ' process
    For I = 4 To Worksheets(ksWSSource).Rows.Count
        ' quit at 1st empty
        If Worksheets(ksWSSource).Cells(I, 1).Value = "" Then Exit For
        ' retrieve key
        iKey = Worksheets(ksWSSource).Cells(I, kiColumnKey).Value
        With Worksheets(ksWSTarget)
            ' put key
            .Range(ksKey).Value = iKey
            ' find row
            J = .Cells.Find(dDate, .Cells(1, kiColumnDate), xlValues, xlWhole).Row
            ' retrieve calculation
            nCalculation = .Cells(J + 1, kiColumnCalculationTarget).Value
            Worksheets(ksWSSource).Cells(I, kiColumnCalculationSource).Value = nCalculation
            ' collapse all groups
            .Outline.ShowLevels 1
            ' expand found group
            .Rows(J - 1).ShowDetail = True
            ' print
            .PrintOut , , , True
        End With
    Next I
    ' end
    Beep
End Sub
Check the starting column for each following line of indented (in my case all) comment line: it's shifted one column to the left. That annoys me.
Regards!
 
@Luke M
Hi!
Just in the very remote but still possible case that it's something related to my computer (OS language, regional configuration settings, user mood or whatsoever it might be) here's how I see it.
If you have the cure for this disease please advise.
Regards!
 

Attachments

  • How do I create macro to combine cells_ (for blcexcel at chandoo.org).png
    How do I create macro to combine cells_ (for blcexcel at chandoo.org).png
    140.8 KB · Views: 5
Good day Marc L
So it's not the same as initial demand was
Click to expand...

One of the biggest problem those new to excel have is that when they post a question they are not sure of what they really need and this leads to many OP posts in the thread, each one a bit different as the OP realise they want something different to what they thought they needed. The Op probably mention this to a co-work and they said "Oh you are going to need VBA to do that" and that's why they came here, to get a good grounding in VBA from those who posted here.....and then the answer they want from Abhijeet R Joshi......;)
 
Hi Shrivallabha,
I've used your wonderful tool and cleaned up that thread. :)
Thanks again.
 
Marc L said:
​
Are we on the same planet ?‼ :cool:​
​
Click to expand...
Hi, Marc L!
Of course we are... here Caesar asks me to send his greetings to you. And Ari's trying to phone you but she's having a little trouble with jungle drums.
Regards!
 
Luke M said:
@SirJB7

So it does, I guess I never noticed.
Click to expand...
@Luke M
Hi, buddy!
I know that now that you're cured of you long time chronic CASFFML illness you might have acquired a new one, CRABY, so let me refresh your memory:
http://chandoo.org/forum/threads/autofill-formula-to-end.11805/#post-69190
http://chandoo.org/forum/threads/autofill-formula-to-end.11805/#post-69206
Regards!
PS: You're not gonna ask me what CRABY stands for, are you?

@all
-@Luke M
Hi!
Just in case... can't remember anything before yesterday...
Regards!
 
You must log in or register to reply here.
Back
Top