Combining several rows in one

Caladbolg17

New member
Joined
Jan 18, 2014
Messages
8
Reaction score
0
Points
0
Hi, everyone!

I have a big amount of data I over 1000 of rows and want to consolidate it, some of them need formating, while others don't.

I have identical text in Columns 1,3 and 4, but the text in Column 2 is different for all.

How do I make 1 row instead of 3 with Column 2 consolidated?

Please see the attachment.

Thanks !
 

Attachments

  • Excel_list_updated.xlsx
    9.3 KB · Views: 15
Use Pivot Tables to get the result...

Hi Caladbolg,

A pivot table can consolidate the data exactly as you require it. No programming needed, no formulas needed :)
Just select your data
Activate the pivot table, and add the fields to the Rows drop area
Switch the table format from Compact View to Tabular View
Switch off sub totals for all the fields

See attached workbook for result...

View attachment 1963
 
Thanks a lot! That may work, though is there a way to make the output result exactly as in the attachment i.e. no additional rows like rows 26 and 27 and letters A, B and C are in one cell?
 
Hello Caladbolg17

I have absolutely no idea how this can be done with a formula but if you are open to a macro have a look at the attached workbook.

I have your data being on sheet1 and put the results on sheet2.

You should also have a look at this http://www.excelguru.ca/content.php?184 because cross posting can be done in a proper manner.
 

Attachments

  • CombineRows.xls
    40 KB · Views: 12
minor adjustment in case active sheet is not sheet1 when macro is run

change
Code:
'determine the range to work with
Set rng = Sheets("Sheet1").Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)

to
Code:
'determine the range to work with
With Sheets("Sheet1")
    Set rng = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With
 
Wow! That's totally awesome!
Though I found out that column 3 also has different values, what should I change in macros for Column 3 to also consolidate in one cell, like Column 2?

Thanks for the info about cross posting, I will keep that in mind.
 
add another line where match is found, similar to what is already there but for column "C" and offset (0,2)

Hope that works for you.
 
Thanks, now the other column consolidates as well
Though some of the rows just disappear after the macro is run
 
Last edited:
Disappear from where?
I'd like to see that. Can you attach the workbook where that happens?
 
After playing around with this I think "disappear" may refer to nothing being added to sheet2 when the macro is run a second time.
Try this
 

Attachments

  • CombineRows_2.xls
    38 KB · Views: 7
I figured out the disappearing.

And finally found out what really is needed. Column 3 sometimes has the values that need to be consolidated and sometimes don't.

Please see the attachment
 

Attachments

  • CombineRows_v2.xls
    39 KB · Views: 6
Thinking the desired results on sheet1 are slightly off what's really desired, try this macro

Code:
Option Explicit

Sub CombineRows()
'
' http://www.excelguru.ca/forums/showthread.php?2551-Combining-several-rows-in-one
'
    Dim rng As Range
    Dim cel As Range
    Dim WriteRow As Double
    Dim Col3string As String
    Dim pos As Long
    
Application.ScreenUpdating = False

'determine the range to work with
With Sheets("Sheet1")
    'Set rng = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    'changed due to desired results using col A
    Set rng = .Range("A2:A" & .Range("A2").End(xlDown).Row)
End With

'cycle through the cells in rng
For Each cel In rng

'if the cel value does not match a value on sheet 2 then add it
On Error Resume Next
    If IsError(Application.WorksheetFunction.Match(cel.Value, Sheets("Sheet2").Range("A:A"), 0)) Then
    'no match
        WriteRow = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1
        'copy the row from sheet 1
        cel.Resize(1, 4).Copy Sheets("Sheet2").Range("A" & WriteRow)
    Else
    'there is a match, so add to what exists in the cell in the column
        'the row being dealt with
        WriteRow = Application.WorksheetFunction.Match(cel.Value, Sheets("Sheet2").Range("A:A"), 0)
        'add info for column B
        Sheets("Sheet2").Range("B" & WriteRow).Value = Sheets("Sheet2").Range("B" & WriteRow).Value & Chr(10) & cel.Offset(0, 1).Value
        
        'need to check if current info already exists in the column C row
        Col3string = Sheets("Sheet2").Range("C" & WriteRow).Value
        'starting position of string in string
        pos = InStr(Col3string, cel.Offset(0, 2).Value)
        'if position <> 0 then already exists
        If pos = 0 Then
            'add to the string
            Sheets("Sheet2").Range("C" & WriteRow).Value = Sheets("Sheet2").Range("C" & WriteRow).Value & Chr(10) & cel.Offset(0, 2).Value
        End If
        
    End If
On Error GoTo 0
Next cel

Application.ScreenUpdating = True

End Sub
 
Wow! That's totally what I wanted!
Thank you for your help and your patience!
 
Back
Top