plz help to solve the issue

[sambit]

sir,
plz help to solve the issue below.

my data is like below format
Invoice No GR No
4501 456
4501 789
4501 324
4501 625
4502 987
4502 534
4506 487
4506 326
4506 723

i want to look like below format.

Invoice No GR No
4501 456/789/324/625
4502 987/534
4506 487/326/723

 

[vletm]

Press [Do it]

 

[sambit]

is it possible by any formula ?

 

[chirayu]

Try this code. Cell A1 & B1 has headers. Column A is Invoice No, B is GR No

Sub Concatenator()

Dim CurrCell As String
Dim Inv As String
Dim GR As String
Dim LstRow As Integer

Columns("E:F").Delete

Columns("A:A").Copy
Range("E1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Selection.RemoveDuplicates 1, xlYes
Range("F1").Value = "GR No"

Range("E2").Select
Do Until IsEmpty(ActiveCell)
  
    CurrCell = ActiveCell.Address
    Inv = ActiveCell.Value
    GR = ""
  
    Range("A2").Select
    Do Until IsEmpty(ActiveCell)
        If ActiveCell = Inv Then
            If Len(GR) = 0 Then
                GR = ActiveCell.Offset(0, 1).Value
                ActiveCell.Offset(1, 0).Select
            Else
                GR = GR & "/" & ActiveCell.Offset(0, 1).Value
                ActiveCell.Offset(1, 0).Select
            End If
        Else
            ActiveCell.Offset(1, 0).Select
        End If
    Loop
    Range(CurrCell).Select
    ActiveCell.Offset(0, 1).Value = GR
    ActiveCell.Offset(1, 0).Select
Loop

LstRow = Cells(Rows.Count, "F").End(xlUp).Row
Range("E1:F" & LstRow).Borders.LineStyle = xlContinuous
Range("E1:F1").Font.Bold = True
Range("E1:F1").Font.Italic = True
Cells.EntireColumn.AutoFit

MsgBox "Macro complete", vbInformation, ""

End Sub

 

[Vishal Srivastava]

Hi,
Please find formula based solution.

Hope you will find it useful.


Courtesy goes to bosco_yip


Thanks & Regards,
CMA Vishal Srivastava

 

[sambit]

Thanks to all for resolve the issue.

 

[bosco_yip]

Improved formula system in concatenate data and become shorter,

1] Helper L5, formula copy down :

=E5&IFERROR(" / "&VLOOKUP(D5,D6:L$14,9,0),"")

2] Unique Invoice no. H5, formula copy down :

=IFERROR(INDEX(D$5:D$13,MATCH(0,INDEX(COUNTIF(H$4:H4,D$5:D$13),0),0)),"")

3] Concatenated GR no. H5, formula copy down :

=IF(H5="","",VLOOKUP(H5,D$5:L$13,9,0))

Regards
Bosco