Converting List of Values to Records

[SBest]

I have a large list of data - order numbers and items. There could be anything from 1 to 200 items per order. I am trying to convert this so that each order number is a single row, with relevant items listed horizontally. So, each order number would be a record with between 1 and 200 items listed against it. I feel like there is a simple soution that I'm missing, but I can't find it and am struggling to put it in the right wording to find the answer online. I have uploaded a simplified example - my data as it is in columns A:B - I am trying to get to something like D:H

Book3
	A	B	C	D	E	F	G	H
1	Item	Order		Order
2	X	1		1	X	Y	Z
3	Y	1		2	A	B	C	X
4	Z	1
5	A	2
6	B	2
7	C	2
8	X	2
9
Sheet1

 

[SBest]

With that sort of data, I wouldn't expect any problems. Try this instead.

Sub SBest()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, nr As Long, nc As Long
  
   With Sheets("Sheet1")
      Ary = .Range("A1:B" & .Range("A" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To 300)
  
   For r = 2 To UBound(Ary)
      If Ary(r, 2) <> Ary(r - 1, 2) Then
         nr = nr + 1
         Nary(nr, 1) = Ary(r, 2)
         Nary(nr, 2) = Ary(r, 1)
         nc = 3
      Else
         nc = nc + 1
         Nary(nr, nc) = Ary(r, 1)
      End If
   Next r
   Sheets("Sheet1").Range("D2").Resize(nr, 300).Value = Nary
End Sub

That works fine with the sample of 100 rows, but get that same run-time error when trying on the full data-set

 

[Fluff]

I've just duplicated your data over 660,000 rows & don't get an Out of Memory Error.
I can only think that somewhere in the data there are some very long strings.

 

[Fluff]

Try it like this

Sub SBest()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, nr As Long, nc As Long, i As Long
   
   With Sheets("Sheet1")
      For i = 300000 To 600000
         If .Cells(i, 2) <> .Cells(i + 1, 2) Then Exit For
      Next i
      Ary = .Range("A1:B" & i).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To 300)
   
   For r = 2 To UBound(Ary)
      If Ary(r, 2) <> Ary(r - 1, 2) Then
         nr = nr + 1
         Nary(nr, 1) = Ary(r, 2)
         Nary(nr, 2) = Ary(r, 1)
         nc = 3
      Else
         nc = nc + 1
         Nary(nr, nc) = Ary(r, 1)
      End If
   Next r
   Sheets("Sheet1").Range("D2").Resize(nr, 300).Value = Nary
   With Sheets("Sheet1")
      Ary = .Range("A" & i + 1 & ":B" & .Range("A" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To 300)
   
   For r = 2 To UBound(Ary)
      If Ary(r, 2) <> Ary(r - 1, 2) Then
         nr = nr + 1
         Nary(nr, 1) = Ary(r, 2)
         Nary(nr, 2) = Ary(r, 1)
         nc = 3
      Else
         nc = nc + 1
         Nary(nr, nc) = Ary(r, 1)
      End If
   Next r
   Sheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Offset(1).Resize(nr, 300).Value = Nary

End Sub

 

[SBest]

Try it like this

Sub SBest()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, nr As Long, nc As Long, i As Long
  
   With Sheets("Sheet1")
      For i = 300000 To 600000
         If .Cells(i, 2) <> .Cells(i + 1, 2) Then Exit For
      Next i
      Ary = .Range("A1:B" & i).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To 300)
  
   For r = 2 To UBound(Ary)
      If Ary(r, 2) <> Ary(r - 1, 2) Then
         nr = nr + 1
         Nary(nr, 1) = Ary(r, 2)
         Nary(nr, 2) = Ary(r, 1)
         nc = 3
      Else
         nc = nc + 1
         Nary(nr, nc) = Ary(r, 1)
      End If
   Next r
   Sheets("Sheet1").Range("D2").Resize(nr, 300).Value = Nary
   With Sheets("Sheet1")
      Ary = .Range("A" & i + 1 & ":B" & .Range("A" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To 300)
  
   For r = 2 To UBound(Ary)
      If Ary(r, 2) <> Ary(r - 1, 2) Then
         nr = nr + 1
         Nary(nr, 1) = Ary(r, 2)
         Nary(nr, 2) = Ary(r, 1)
         nc = 3
      Else
         nc = nc + 1
         Nary(nr, nc) = Ary(r, 1)
      End If
   Next r
   Sheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Offset(1).Resize(nr, 300).Value = Nary

End Sub

That has done the job - many thanks for your help!

 

[Fluff]

You're welcome & thanks for the feedback.