Split 1 column into many but consolidate by date

[Jumparound]

Hi,

I hope I can explain this properly. We have a long list of data in sheet1 (columns B to I). Short excerpt here, the real data is around 3,000 rows.

Customer	Batch	Size	Quantity	Material	Location	Date	Type
Apples	4281​		21​	CF1	AR05	09/01/2023​	CF1-3
Apples	5559​		4​	CF1	AR05	09/01/2023​	CF1-3
Apples	8050​		4​	CF1	AR05	09/01/2023​	CF1-3
Apples	2704​		3​	CF1	AR05	09/01/2023​	CF1-3
Apples	7801​		6​	CF1	AR05	09/01/2023​	CF1-3
Apples	6361​		3​	CF1	AR05	09/01/2023​	CF1-3
Apples	6486​		8​	CF1	AR05	09/01/2023​	CF1-3
Apples	6028​		4​	CF4	AR05	09/01/2023​	CF 4-6
Apples	7591​		2​	CF6	AR05	09/01/2023​	CF 4-6
Apples	5048​		1​	CF4	AR05	09/01/2023​	CF 4-6
Apples	2624​	60L	6​	CF1	AR05	09/01/2023​	Crates
Apples	6441​	115L	9​	CF1	AR05	09/01/2023​	Crates
Apples	2893​	115L	1​	CF1	AR05	09/01/2023​	Crates
Apples	5891​		31​	CF1	AR02	11/01/2023​	CF1-3
Apples	6376​		11​	CF1	AR02	11/01/2023​	CF1-3
Apples	8579​		1​	CF1	AR02	11/01/2023​	CF1-3
Apples	9769​		2​	CF1	AR02	11/01/2023​	CF1-3
Apples	6429​		3​	CF4	AR02	11/01/2023​	CF 4-6
Apples	1159​		1​	CF4	AR02	11/01/2023​	CF 4-6
Apples	4117​		3​	CF4	AR02	11/01/2023​	CF 4-6
Apples	9729​		4​	CF4	AR02	11/01/2023​	CF 4-6
Apples	3458​		2​	CF6	AR02	11/01/2023​	CF 4-6
Apples	6001​		4​	CF6	AR02	11/01/2023​	CF 4-6
Apples	8116​	60L	2​	CF1	AR02	11/01/2023​	Crates
Apples	5045​	115L	5​	CF1	AR02	11/01/2023​	Crates
Apples	5750​	IBC	1​	CF1	WTSF	11/01/2023​	Crates
Apples	8048​	115L	1​	CF1	AR02	11/01/2023​	Crates
Apples	8194​	115L	1​	CF1	AR02	11/01/2023​	Crates

I want to separate this into columns in Sheet2 by type (column H) and date but with the minimum number of rows so there is not a lot of unused space as per the example below.

Date

Customer

Batch

Size

Quantity

Material

Location

Type

Customer

Batch

Size

Quantity

Material

Location

Type

Customer

Batch

Size

Quantity

Material

Location

Type

09/01/2023​

Apples

4281​

21​

CF1

AR05

CF1-3

Apples

6028​

4​

CF4

AR05

CF 4-6

Apples

2624​

60L

6​

CF1

AR05

Crates

09/01/2023​

Apples

5559​

4​

CF1

AR05

CF1-3

Apples

7591​

2​

CF6

AR05

CF 4-6

Apples

6441​

115L

9​

CF1

AR05

Crates

09/01/2023​

Apples

8050​

4​

CF1

AR05

CF1-3

Apples

5048​

1​

CF4

AR05

CF 4-6

Apples

2893​

115L

1​

CF1

AR05

Crates

09/01/2023​

Apples

2704​

3​

CF1

AR05

CF1-3

09/01/2023​

Apples

7801​

6​

CF1

AR05

CF1-3

09/01/2023​

Apples

6361​

3​

CF1

AR05

CF1-3

09/01/2023​

Apples

6486​

8​

CF1

AR05

CF1-3

11/01/2023​

Apples

5891​

31​

CF1

AR02

CF1-3

Apples

6429​

3​

CF4

AR02

CF 4-6

Apples

8116​

60L

2​

CF1

AR02

Crates

11/01/2023​

Apples

6376​

11​

CF1

AR02

CF1-3

Apples

1159​

1​

CF4

AR02

CF 4-6

Apples

5045​

115L

5​

CF1

AR02

Crates

11/01/2023​

Apples

8579​

1​

CF1

AR02

CF1-3

Apples

4117​

3​

CF4

AR02

CF 4-6

Apples

5750​

IBC

1​

CF1

WTSF

Crates

11/01/2023​

Apples

9769​

2​

CF1

AR02

CF1-3

Apples

9729​

4​

CF4

AR02

CF 4-6

Apples

8048​

115L

1​

CF1

AR02

Crates

11/01/2023​

Apples

3458​

2​

CF6

AR02

CF 4-6

Apples

8194​

115L

1​

CF1

AR02

Crates

11/01/2023​

Apples

6001​

4​

CF6

AR02

CF 4-6

So there are only 7 rows of dates for the 9th Jan because that is the maximum number of rows needed for the most types in that day (7 CF1-3). Then for the 11th Jan there are 6 rows because the maximum that day is type CF 4-6. Is this possible? Thanks!

 

[DanteAmor]

We have a long list of data in sheet1 (columns B to I)

Considering that your data starts in cell B1, then in sheet2 the results will also start in cell B1.

Try this macro:

Sub Split_Data()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim a As Variant, b As Variant, d_ant As Variant, t_ant As Variant
  Dim i&, j&, k&, new_r&, new_c&, kmax&, col&
  
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
  
  a = sh1.Range("B1", sh1.Range("I" & Rows.Count).End(3)).Value
  ReDim b(1 To UBound(a, 1), 1 To 100)
  
  For i = 2 To UBound(a, 1)
    If d_ant <> a(i, 7) Then
      new_r = kmax + 1
      new_c = 2
      k = new_r
      kmax = k
    Else
      If t_ant <> a(i, 8) Then
        new_c = new_c + 7
        k = new_r
      Else
        k = k + 1
      End If
    End If
    If k > kmax Then kmax = k
    
    b(k, 1) = a(i, 7)
    b(k, new_c) = a(i, 1)
    b(k, new_c + 1) = a(i, 2)
    b(k, new_c + 2) = a(i, 3)
    b(k, new_c + 3) = a(i, 4)
    b(k, new_c + 4) = a(i, 5)
    b(k, new_c + 5) = a(i, 6)
    b(k, new_c + 6) = a(i, 8)
    
    d_ant = a(i, 7)   'date
    t_ant = a(i, 8)   'type
  Next
  
  Application.ScreenUpdating = False
  sh2.Cells.ClearContents
  sh2.Range("B1").Value = "Date"
  sh2.Range("C1:H1").Value = sh1.Range("B1:G1").Value
  sh2.Range("I1").Value = sh1.Range("I1").Value
  sh2.Range("B2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
  col = sh2.Cells.Find("*", , xlValues, xlPart, xlByColumns, xlPrevious).Column
  sh2.Range("C1:I1").Copy sh2.Range("J1", sh2.Cells(1, col))
  Application.ScreenUpdating = True
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------

 

[Jumparound]

Wow! Amazing, thank you so much! Works perfectly!