Blessy Clara

Board Regular
Joined
Mar 28, 2010
Messages
193
Hi All,

I have a list of records

3

<tbody>
</tbody>
Youth Services

<tbody>
</tbody>
3

<tbody>
</tbody>
Family / Whanau Services

<tbody>
</tbody>
3

<tbody>
</tbody>
Family Violence

<tbody>
</tbody>
3

<tbody>
</tbody>
Education and Training

<tbody>
</tbody>
6

<tbody>
</tbody>
Family / Whanau Services

<tbody>
</tbody>
6

<tbody>
</tbody>
Basic Needs

<tbody>
</tbody>
6

<tbody>
</tbody>
Education and Training

<tbody>
</tbody>
15

<tbody>
</tbody>
Family / Whanau Services

<tbody>
</tbody>
15

<tbody>
</tbody>
Health

<tbody>
</tbody>

<tbody>
</tbody>

I would like to merge rows based on the Index number into Single Row as given below

3
Youth Services, Family / Whanau Services, Family Violence, Education and Training

<tbody>
</tbody>
6
Family / Whanau Services, Basic Needs

<tbody>
</tbody>
15Family / Whanau Services, Health

<tbody>
</tbody>

Thank you
 

Some videos you may like

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
3,186
Office Version
  1. 2016
Platform
  1. Windows
Are there any blank rows within the data? If yes, is it OK to delete those rows?
 

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
3,186
Office Version
  1. 2016
Platform
  1. Windows
Here's a macro based upon built-in XL tools and functions :
Code:
Sub IMerge()
Dim rng As Range
Application.ScreenUpdating = False
On Error Resume Next
Range([A2], Cells(Rows.Count, "A").End(xlUp)) _
    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
Set rng = Range([A2], Cells(Rows.Count, "A").End(xlUp))
rng.Offset(0, 2).Formula = "=IF(A2<>A3,0,""d"")"
rng.Offset(0, 3).Formula = "=IF(A2<>A1,B2,D1 & "", "" & B2)"
With rng.Offset(0, 2).Resize(, 2)
    .Value = .Value
End With
On Error Resume Next
rng.Offset(0, 2).SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
On Error GoTo 0
[B:C].Delete
End Sub
 
Last edited:

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
3,186
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

Cleaned-up a bit :
Code:
Sub IMerge()
Dim rng As Range
Application.ScreenUpdating = False
On Error Resume Next
Range([A2], Cells(Rows.Count, "A").End(xlUp)) _
    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
Set rng = Range([A2], Cells(Rows.Count, "A").End(xlUp)).Offset(0, 2)
rng.Formula = "=IF(A2<>A3,0,""d"")"
rng.Offset(0, 1).Formula = "=IF(A2<>A1,B2,D1 & "", "" & B2)"
With rng.Resize(, 2)
    .Value = .Value
End With
On Error Resume Next
rng.SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
On Error GoTo 0
[B:C].Delete Shift:=xlToLeft
End Sub
 

Mike Szczesny

Active Member
Joined
Feb 7, 2008
Messages
411
Can you use this? I created a simple example from your format. Assume your number range is A1:A7, your services range is B1:B7, Assume Number field is in C1. Assume Description field is in D1. Put formula to find unique items in C2. Use Cntrl+Shift+Enter and copy down. This formula is
=INDEX($A$1:$A$7,MATCH(0,COUNTIF($C$1:C1,$A$1:$A$7),0))
Place formula for numbers in D2. This formula first concatenates the descriptions matching a given number. The concatenation formula will produce FALSE for those numbers that do not match. Then I use a substitute formula to remove the "FALSE" results with "".

This formula is below. Before entering you need to highlight the transpose part of the formula all the way to the second ). Highlight wit your mouse. Hit F9. The remove both { and }. Hit enter. Because of this additional step, you will not be able to copy down.
=substitute(concatenate(transpose(if($A$1:$A$7=$C$2,$B$1:$B$7&" / "))),"FALSE","")

<tbody>
</tbody>

3aNumberDescription
3b3a / b / c /
3c6
6d15
6e
15f
15g

<colgroup><col span="3"><col></colgroup><tbody>
</tbody>

<tbody>
</tbody>
 

Watch MrExcel Video

Forum statistics

Threads
1,123,318
Messages
5,600,925
Members
414,416
Latest member
Nobu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top