Merge cell info with conditional formatting?

[seglaren]

Hi all

I am working on a big spreadsheet and got a bit stuck. I would appreciate some help from you.

I'd like to attach a spreadsheet - how do I do that?

Basically, I have a list of clients that receive different reports. Column A shows the recipient name, column B shows the report ID.
So, I would like to in cell A1 show all recipients separated by semi colon and cell B1 the report ID.

Example
Mary 123
Joe 123
Mark 432
Peter 765


The above should become:
Mary; Joe 123
Mark 432
Peter 765

Thanks very much in advance!!

 

[seglaren]

Anyone, please?

 

[AlphaFrog]

Sub Merge_IDs()

    Dim IDs As Range, ID As Range, Found As Range, Lastrow As Long
    
    Application.ScreenUpdating = False
    Rows(1).Insert
    Lastrow = Range("B" & Rows.Count).End(xlUp).Row
    Range("B1:B" & Lastrow).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    Set IDs = Range("B2:B" & Lastrow).SpecialCells(xlCellTypeVisible)
    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
    
    For Each ID In IDs
        If Not IsEmpty(ID) Then
            Set Found = Range("B:B").Find(ID.Value, ID, xlValues, xlWhole, xlByRows, xlNext, False)
            Do While Found.Address <> ID.Address
                ID.Offset(, -1).Value = ID.Offset(, -1).Value & "; " & Found.Offset(, -1).Value
                Found.Offset(, -1).Resize(, 2).Delete Shift:=xlShiftUp
                Set Found = Range("B:B").Find(ID.Value, ID)
            Loop
        End If
    Next ID
    
    Rows(1).Delete
    Columns("A").ColumnWidth = 100
    Columns("A").Columns.AutoFit
    Application.ScreenUpdating = True
    
End Sub

 

[seglaren]

Thank you AlphaFrog.

So where do I insert this code?

 

[AlphaFrog]

• Alt+F11 to open the VBA macro editor
• Select Insert\ Module from the VBA menu
• Paste the code in the edit window.

Back in Excel, run the macro Merge_IDs (Alt+F8)
Test it 1st on a copy of your data.

 

[seglaren]

Thanks a million!!!! It worked!

 

[AlphaFrog]

You're welcome.