Macro to concatenate a varying number of cells

[salasv]

Hi,

I have a monthly report which shows our internal tickets and corresponding vendor tickets. Some of our internal tickets may not have a vendor ticket or may have only one vendor ticket, while others will have two or more vendor tickets. I've included a sample of the data below. I want column E to show the vendor tickets and to consolidate rows with 2 or more vendor tickets to one row.

I was thinking there might be a way to do with this a function if I had the count of vendor tickets per internal ticket, so I created the following function in column B. This probably won't be necessary for the macro, but here it is just in case. =IF(AND(C2=C1,ISNUMBER(B1)=TRUE),B1+1,IF(AND(C2=C1,C2=C3,ISNUMBER(B1)=TRUE),B1+1,IF(C2=C3,1,"")))

The amount of data will vary every month, so the macro will have to be able to handle varying numbers of rows. I'm also including this step as part of a larger macro to format the data, so any additional information on incorporating a macro for this purpose would be helpful.


[TABLE="class: grid, width: 399"]
<tbody>[TR]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]E[/TD]
[/TR]
[TR]
[TD]DATE_SUBMITTED[/TD]
[TD][/TD]
[TD]Internal[/TD]
[TD]Vendor[/TD]
[TD]Vendor Consolidated[/TD]
[/TR]
[TR]
[TD="align: right"]6/1/2013 6:15[/TD]
[TD][/TD]
[TD="align: right"]75471[/TD]
[TD="align: right"]70061[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/2/2013 10:53[/TD]
[TD][/TD]
[TD="align: right"]75472[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/8/2013 23:32[/TD]
[TD][/TD]
[TD="align: right"]75552[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/2/2013 15:32[/TD]
[TD][/TD]
[TD="align: right"]75661[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/3/2013 11:59[/TD]
[TD][/TD]
[TD="align: right"]75662[/TD]
[TD="align: right"]70209[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/5/2013 5:23[/TD]
[TD][/TD]
[TD="align: right"]75752[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/2/2013 19:56[/TD]
[TD][/TD]
[TD="align: right"]75861[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/5/2013 10:54[/TD]
[TD][/TD]
[TD="align: right"]75863[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/5/2013 22:08[/TD]
[TD][/TD]
[TD="align: right"]75864[/TD]
[TD="align: right"]70230[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/6/2013 6:33[/TD]
[TD][/TD]
[TD="align: right"]75865[/TD]
[TD="align: right"]70269[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/7/2013 14:09[/TD]
[TD][/TD]
[TD="align: right"]75866[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/3/2013 8:55[/TD]
[TD][/TD]
[TD="align: right"]75964[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/2/2013 13:01[/TD]
[TD][/TD]
[TD="align: right"]76046[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/3/2013 19:05[/TD]
[TD][/TD]
[TD="align: right"]76047[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/3/2013 12:30[/TD]
[TD][/TD]
[TD="align: right"]76146[/TD]
[TD="align: right"]70212[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/4/2013 6:16[/TD]
[TD][/TD]
[TD="align: right"]76147[/TD]
[TD="align: right"]70209[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/4/2013 6:16[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]76148[/TD]
[TD="align: right"]70215[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/4/2013 6:16[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]76148[/TD]
[TD="align: right"]70259[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/4/2013 6:16[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]76148[/TD]
[TD="align: right"]70272[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/4/2013 6:39[/TD]
[TD][/TD]
[TD="align: right"]76149[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/4/2013 11:24[/TD]
[TD][/TD]
[TD="align: right"]76150[/TD]
[TD="align: right"]70232[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/4/2013 12:36[/TD]
[TD][/TD]
[TD="align: right"]76151[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/5/2013 6:16[/TD]
[TD][/TD]
[TD="align: right"]76153[/TD]
[TD="align: right"]70234[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/5/2013 6:16[/TD]
[TD][/TD]
[TD="align: right"]76154[/TD]
[TD="align: right"]70236[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/5/2013 6:54[/TD]
[TD][/TD]
[TD="align: right"]76155[/TD]
[TD="align: right"]70246[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/5/2013 7:42[/TD]
[TD][/TD]
[TD="align: right"]76156[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/5/2013 12:45[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]76157[/TD]
[TD="align: right"]70249[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/5/2013 12:45[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]76157[/TD]
[TD="align: right"]70254[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/5/2013 15:03[/TD]
[TD][/TD]
[TD="align: right"]76159[/TD]
[TD="align: right"]70239[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/6/2013 6:15[/TD]
[TD][/TD]
[TD="align: right"]76160[/TD]
[TD="align: right"]70247[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]6/6/2013 9:27[/TD]
[TD][/TD]
[TD="align: right"]76162[/TD]
[TD="align: right"]70268[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


Thank you, in advance, for your time and assistance!!

 

[salasv]

I found macro code on another website (macros - Combine multiple rows with same value into one plus more... in Excel - Stack Overflow) provided by Chris Neilsen and adapted it for my data and appearance. It works for the general idea, but deletes the entire sheet and replaces it with just data in columns C & D. I have 21 columns of data with 983 rows so far this month, so I can't have it delete the sheet. I need it to just delete the duplicate rows or to write the data to first cell of the duplicate internal ticket, so I can delete duplicates or some other genius idea you'll have. Any suggestions on further amending this to make it work for my needs?

Sub MergeRows()
    Dim rng As Range
    Dim vSrc As Variant
    Dim vDst() As Variant
    Dim i As Long, j As Long

    ' Assumes data starts at cell C2 and extends down with no empty cells
    Set rng = Range([C2], [C2].End(xlDown))

    ' Count unique values in column C
    j = Application.Evaluate("SUM(IF(FREQUENCY(" _
        & rng.Address & "," & rng.Address & ")>0,1))")
    ReDim vDst(1 To j, 1 To 2)
    j = 1

    ' Get original data into an array
    vSrc = rng.Resize(, 2)

    ' Create new array, one row for each unique value in column A
    vDst(1, 1) = vSrc(1, 1)
    vDst(1, 2) = "'" & vSrc(1, 2)
    For i = 2 To UBound(vSrc, 1)
        If vSrc(i - 1, 1) = vSrc(i, 1) Then
            vDst(j, 2) = vDst(j, 2) & Chr(10) & vSrc(i, 2)
        Else
            j = j + 1
            vDst(j, 1) = vSrc(i, 1)
            vDst(j, 2) = "'" & vSrc(i, 2)
        End If

    Next

    ' Remove old data
    rng.EntireRow.Delete

    ' Put new data in sheet
    Set rng = [C2].Resize(j, 2)
    rng = vDst

End Sub

 

[salasv]

Anyone have any ideas on how I can make this work?

 

[dermie_72]

remove rng.EntireRow.Delete

from the code. See if that helps.

 

[salasv]

Sorry for my delay. I tried replying to this and I guess I had problems because my reply didn't post.

I did try removing the rng.EntireRow.Delete but this caused the data to be out-of-synch with the other information. The data is written back to the column and not lined up to original rows it was on because the duplicate rows are left behind. It also overwrites the original data, so I'm not able to figure out which row it corresponded to.