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

 

[Fluff]

Can you please post some sample data using the XL2BB add-in
Will every location always have all 6 options?

 

[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


View attachment 11315View attachment 11316

Can you please post some sample data using the XL2BB add-in
Will every location always have all 6 options?

Can you please post some sample data using the XL2BB add-in
Will every location always have all 6 options?

Here it is

Dummy Data.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Current Dataset					Desired Outome
2	Drug	Period	Location	Options	Values	Drug	Period	Location	Collected	Sold	Expired	Damaged	Administered	Needed
3	Vitamin C	201909	Hospital	Collected	3	Vitamin C	201909	Hospital	3	2	1	0	4	10
4	Vitamin C	201909	Hospital	Sold	2	Vitamin C	201909	Facility	2	3	4	5	10	12
5	Vitamin C	201909	Hospital	Expired	1	Vitamin D	201909	Health clinic	10	15	9	8	7	6
6	Vitamin C	201909	Hospital	Damaged	0	Vitamin D	201909	Health Post	12	14	11	8	9	21
7	Vitamin C	201909	Hospital	Administered	4
8	Vitamin C	201909	Hospital	Needed	10
9	Vitamin C	201909	facility	Collected	2
10	Vitamin C	201909	facility	Sold	3
11	Vitamin C	201909	facility	Expired	4
12	Vitamin C	201909	facility	Damaged	5
13	Vitamin C	201909	facility	Administered	10
14	Vitamin C	201909	facility	Needed	12
15	Vitamin D	201909	Health clinic	Collected	10
16	Vitamin D	201909	Health clinic	Sold	15
17	Vitamin D	201909	Health clinic	Expired	9
18	Vitamin D	201909	Health clinic	Damaged	8
19	Vitamin D	201909	Health clinic	Administered	7
20	Vitamin D	201909	Health clinic	Needed	6
21	Vitamin D	201909	Health Post	Collected	12
22	Vitamin D	201909	Health Post	Sold	14
23	Vitamin D	201909	Health Post	Expired	11
24	Vitamin D	201909	Health Post	Damaged	8
25	Vitamin D	201909	Health Post	Administered	9
26	Vitamin D	201909	Health Post	Needed	21
Currently

 

[Fluff]

Thanks for that, could you also please answer my question?

 

[Bisola]

Can you please post some sample data using the XL2BB add-in
Will every location always have all 6 options?

Yes, every location will have the 6 options

 

[Fluff]

Ok, how about

Sub Bisola()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
   
   Ary = Range("A2: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

 

[alansidman]

Simple Pivot Table.

 

[Bisola]

Ok, how about

Sub Bisola()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
  
   Ary = Range("A2: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

Okay, I'll try this out

 

[Bisola]

Ok, how about

Sub Bisola()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
  
   Ary = Range("A2: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

Thanks but when I run it, It pops an error (Run-time error '9' Subscript out of range)

 

[Fluff]

Which line gives that error?