Split Records

[vmjan02]

I have this data,

Fixed FTTH CBU Tech Compliants V1.xlsm
	B	C	D
24	Node*+	Root Cause	Ticket Number+
25	218-00_SAFAKH00OL0	Access-Uplink issue	PR00035914963
26			PR00035915931
27		Dark Fiber	PR00035913520
28			PR00035914983
29			PR00035916061
30			PR00035917254
31			PR00035920093
32		MDT	PR00035931421
33			PR00035931520
34			PR00035933798
35			PR00035933799
36			PR00035933811
37	116-42_NFELRDAAOLK	Man Made	PR00035951924
38	111-00_HTYNRD00OL5	MDT	PR00035909693
39			PR00035923231
40		Trans Media	PR00035963757
41	116-42_NFELRDAAOT1	Trans Media	PR00035967382
OLT2

and I have this code

Sub split_recordsOLT2()
  Dim dic As Object
  Dim nCol As Long, nRow As Long, i As Long
  Dim a As Variant, b As Variant
 
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 '''''
 ''''' OLT2
 '''''
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
  Set dic = CreateObject("Scripting.Dictionary")
  a = Range("C25", Range("D" & Rows.Count).End(3)).Value
  ReDim b(1 To UBound(a, 1), 1 To 100)
 
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 1)) Then
      dic(a(i, 1)) = i
      nCol = 1
    Else
      nCol = nCol + 1
    End If
    b(dic(a(i, 1)), nCol) = a(i, 2)
  Next
 
  Range("E25").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

but I am looking for this output, any modification on the code.

Fixed FTTH CBU Tech Compliants V1.xlsm
	B	C	D	E	F	G	H	I
24	Node*+	Root Cause	Ticket Number+	Output1	Output2	Output3	Output4	Output5
25	218-00_SAFAKH00OL0	Access-Uplink issue	PR00035914963	PR00035914963	PR00035915931
26			PR00035915931
27		Dark Fiber	PR00035913520	PR00035913520	PR00035914983	PR00035916061	PR00035917254	PR00035920093
28			PR00035914983
29			PR00035916061
30			PR00035917254
31			PR00035920093
32		MDT	PR00035931421	PR00035931421	PR00035931520	PR00035933798	PR00035933799	PR00035933811
33			PR00035931520
34			PR00035933798
35			PR00035933799
36			PR00035933811
37	116-42_NFELRDAAOLK	Man Made	PR00035951924	PR00035951924
38	111-00_HTYNRD00OL5	MDT	PR00035909693	PR00035909693	PR00035923231
39			PR00035923231
40		Trans Media	PR00035963757	PR00035963757
41	116-42_NFELRDAAOT1	Trans Media	PR00035967382	PR00035967382
OLT2

 

[JEC]

Assuming the data starts in A1

Sub jec()
 Dim ar, j As Long, y As Long
 With Cells(1).CurrentRegion.Resize(, 4)
  ar = .Value
  For j = 2 To UBound(ar)
   If ar(j, 2) <> "" Then
     ar(j, 4) = ar(j, 3)
     y = j
   ElseIf ar(j, 2) = "" Then
     ar(y, 4) = ar(y, 4) & "|" & ar(j, 3)
   End If
  Next
  .Value = ar
  .Columns(4).TextToColumns Range("D1"), 1, , , , , , , 1, "|"
 End With
End Sub

 

[vmjan02]

Assuming the data starts in A1

Sub jec()
 Dim ar, j As Long, y As Long
 With Cells(1).CurrentRegion.Resize(, 4)
  ar = .Value
  For j = 2 To UBound(ar)
   If ar(j, 2) <> "" Then
     ar(j, 4) = ar(j, 3)
     y = j
   ElseIf ar(j, 2) = "" Then
     ar(y, 4) = ar(y, 4) & "|" & ar(j, 3)
   End If
  Next
  .Value = ar
  .Columns(4).TextToColumns Range("D1"), 1, , , , , , , 1, "|"
 End With
End Sub

by any way can you modify this code, as my data don't start from A1 but it starts from B25 please ref my post1 here i have mention "I have this data," B24 is header

 

[JEC]

You could try

Sub jec()
 Dim ar, j As Long, y As Long
 With [B24].CurrentRegion.Resize(, 4)
  ar = .Value
  For j = 2 To UBound(ar)
   If ar(j, 2) <> "" Then
     ar(j, 4) = ar(j, 3)
     y = j
   ElseIf ar(j, 2) = "" Then
     ar(y, 4) = ar(y, 4) & "|" & ar(j, 3)
   End If
  Next
  .Value = ar
  .Columns(4).TextToColumns [E25], 1, , , , , , , 1, "|"
 End With
End Sub

 

[vmjan02]

You could try

Sub jec()
 Dim ar, j As Long, y As Long
 With [B24].CurrentRegion.Resize(, 4)
  ar = .Value
  For j = 2 To UBound(ar)
   If ar(j, 2) <> "" Then
     ar(j, 4) = ar(j, 3)
     y = j
   ElseIf ar(j, 2) = "" Then
     ar(y, 4) = ar(y, 4) & "|" & ar(j, 3)
   End If
  Next
  .Value = ar
  .Columns(4).TextToColumns [E25], 1, , , , , , , 1, "|"
 End With
End Sub

It is giving me the desired output, but in this line

  .Columns(4).TextToColumns [E25], 1, , , , , , , 1, "|"

Giving me error as 1004 (screen shot)

 

[Alex Blakenburg]

Change the E25 to E24

 

[vmjan02]

Change the E25 to E24

Haha, if i do so no "|"

 

[Alex Blakenburg]

So it works now right ?

 

[vmjan02]

Change the E25 to E24

your idea of putting "|" is very good, but not sure why it is giving me error 1004

on line

   .Columns(4).TextToColumns [E24], 1, , , , , , , 1, "|"

Book2
	B	C	D	E
24	Node*+	Root Cause	Ticket Number+
25	218-00_SAFAKH00OL0	Access-Uplink issue	PR00035914963	PR00035914963|PR00035915931
26			PR00035915931
27		Dark Fiber	PR00035913520	PR00035913520|PR00035914983|PR00035916061|PR00035917254|PR00035920093
28			PR00035914983
29			PR00035916061
30			PR00035917254
31			PR00035920093
32		MDT	PR00035931421	PR00035931421|PR00035931520|PR00035933798|PR00035933799|PR00035933811
33			PR00035931520
34			PR00035933798
35			PR00035933799
36			PR00035933811
37	116-42_NFELRDAAOLK	Man Made	PR00035951924	PR00035951924
38	111-00_HTYNRD00OL5	MDT	PR00035909693	PR00035909693|PR00035923231
39			PR00035923231
40		Trans Media	PR00035963757	PR00035963757
41	116-42_NFELRDAAOT1	Trans Media	PR00035967382	PR00035967382
Sheet1

 

[Alex Blakenburg]

It was @JEC's idea not mine and quite a neat way of keeping the code to a minimum.
It is working fine for me using [B24] and [E24] so there has to be something about your data.

If you add the line in blue after the with statement what does it show in the immediate window ?

 With [B24].CurrentRegion.Resize(, 4)
  Debug.Print .Address