Transpose multiple columns based on unique values

[Bisola]

Hi everyone,
I'm trying to transpose multiple columns based on unique values but I don't know how to go about it. It can't be done manually because the dataset is really large about 300,000 rows. So, I'm going to share a dummy file of how it is currently and how it's expected to be. Please help, it's quite urgent

 

[Bisola]

Which line gives that error?

This
Nary(nr, c + 4) = Ary(r + c, 5)

 

[Fluff]

Does your data start in row 2 with a header in row 1?
Also is it laid out exactly as the data you supplied?

 

[Bisola]

Does your data start in row 2 with a header in row 1?
Also is it laid out exactly as the data you supplied?

Yes, the data start in row 2 with a header in row 1 exactly as the dummy dataset I shared, Although Row 1 is merged just as it in the excel file shared

 

[Fluff]

In that case try

Sub Bisola()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
   
   Ary = Range("A3:E" & Range("A" & Rows.Count).End(xlUp).Row)
   ReDim Nary(1 To UBound(Ary), 1 To 9)
   For r = 1 To UBound(Ary) Step 6
      nr = nr + 1
      Nary(nr, 1) = Ary(r, 1)
      Nary(nr, 2) = Ary(r, 2)
      Nary(nr, 3) = Ary(r, 3)
      For c = 0 To 5
         Nary(nr, c + 4) = Ary(r + c, 5)
      Next c
   Next r
   Range("H1:P1").Value = Array("Drug", "Period", "Location", "Collected", "Sold", "Expired", "Damaged", "Administered", "Needed")
   Range("H2").Resize(nr, 9).Value = Nary
End Sub

 

[Bisola]

In that case try

Sub Bisola()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
  
   Ary = Range("A3:E" & Range("A" & Rows.Count).End(xlUp).Row)
   ReDim Nary(1 To UBound(Ary), 1 To 9)
   For r = 1 To UBound(Ary) Step 6
      nr = nr + 1
      Nary(nr, 1) = Ary(r, 1)
      Nary(nr, 2) = Ary(r, 2)
      Nary(nr, 3) = Ary(r, 3)
      For c = 0 To 5
         Nary(nr, c + 4) = Ary(r + c, 5)
      Next c
   Next r
   Range("H1:P1").Value = Array("Drug", "Period", "Location", "Collected", "Sold", "Expired", "Damaged", "Administered", "Needed")
   Range("H2").Resize(nr, 9).Value = Nary
End Sub

Yay!!!!!!! It worked! Thanks so much

 

[Fluff]

You're welcome & thanks for the feedback

 

[alansidman]

Pivot Table result

Book1
	F	G	H	I	J	K	L	M	N	O	P
1	Desired Outome
2	Drug	Period	Location	Collected	Sold	Expired	Damaged	Administered	Needed
3	Vitamin C	201909	Hospital	3	2	1	0	4	10
4	Vitamin C	201909	Facility	2	3	4	5	10	12
5	Vitamin D	201909	Health clinic	10	15	9	8	7	6
6	Vitamin D	201909	Health Post	12	14	11	8	9	21
7
8
9
10		Sum of Values2			Options
11		Drug	Period	Location	Administered	Collected	Damaged	Expired	Needed	Sold
12		Vitamin C
13			201909
14				facility	10	2	5	4	12	3
15				Hospital	4	3	0	1	10	2
16		Vitamin D
17			201909
18				Health clinic	7	10	8	9	6	15
19				Health Post	9	12	8	11	21	14
20
Sheet1