Macro to Merge Rows Based on Condition

[Nani520]

Hi All,

Appreciate if anyone can assist to build a macro to merge 2 or multiple rows if conditions met (Merged into 1 row based on No).
Any help is most appreciated! Thanks in advance.

Initial Data:

No	Avail	Start Date	Figure	Reference
1	Lee	1/2/2015	123456	951623
2	Low	1/6//2016	456789	852165
2	Low	1/6//2016	987456
3	Lim	6/8/2017	639852	785412
3	Lim	6/8/2017	741258	652398
3	Lim	6/8/2017		845126
4	John	9/11/2018	958746	741852

Result:

No	Avail	Start Date	Figure	Reference
1	Lee	1/2/2015	123456	951623
2	Low	1/6//2016	456789/987456	852165
3	Lim	6/8/2017	639852/741258	785412/652398/845126
4	John	9/11/2018	958746	741852

 

[maabadi]

Try this:

Sub Test()
Dim i As Long, Lr As Long, j As Long, K As Long, M As Long, T As String, F As String
Lr = Range("A" & Rows.Count).End(xlUp).Row
K = 2
Range("G1:K1").Value = Range("A1:E1").Value
For i = 2 To Lr
Range("G" & K).Value = Range("A" & i).Value
Range("H" & K).Value = Range("B" & i).Value
Range("I" & K).Value = Range("C" & i).Value
M = Range("A2:A" & Lr).Find(Range("A" & i).Value, , , , , xlPrevious, , , True).Row
For j = i To M
If Range("D" & j).Value <> "" Then T = T & "/" & Range("D" & j).Value
If Range("E" & j).Value <> "" Then F = F & "/" & Range("E" & j).Value
Next j
Range("J" & K).Value = Right(T, Len(T) - 1)
Range("K" & K).Value = Right(F, Len(F) - 1)
K = K + 1
i = M
T = ""
F = ""
Next i
End Sub