Macro to rearrange data order from one sheet to another

crispangilinan

New Member
Joined
Sep 16, 2021
Messages
4
Office Version
  1. 365
  2. 2019
  3. 2016
Hi Excel Gurus. I need your expert guidance on how to write a simple macro that will help to reorganize my raw data from Sheet 1 into Sheet 2. Basically, each data entry on Sheet 1 will be broken down into 8 data points once transferred to Sheet 2.

From this:
Sheet 1 Data
Full TimeFull TimeFull TimeFull TimePart TimePart TimePart TimePart Time
LocationEmp IDManagerEmailNameQ1Q2Q3Q4Q5Q6Q7Q8
Location 1
100001​
Manager 1email 1Employee 100010001
Location 2
100002​
Manager 2email 2Employee 200100010
Location 3
100003​
Manager 3email 3Employee 301000100
Location 4
100004​
Manager 4email 4Employee 410111011
Location 5
100005​
Manager 5email 5Employee 500000000
Location 1
100006​
Manager 6email 6Employee 600000000
Location 2
100007​
Manager 7email 7Employee 701010101
Location 3
100008​
Manager 8email 8Employee 810001000
Location 4
100009​
Manager 9email 9Employee 900000000
Location 5
100010​
Manager 10email 10Employee 1001100110
Location 1
100011​
Manager 1email 11Employee 1100000000
Location 2
100012​
Manager 2email 12Employee 1200000000
Location 3
100013​
Manager 3email 13Employee 1300010001
Location 4
100014​
Manager 4email 14Employee 1400100010
Location 5
100015​
Manager 5email 15Employee 1501000100
Location 1
100016​
Manager 6email 16Employee 1610001000
Location 2
100017​
Manager 7email 17Employee 1700100010
Location 3
100018​
Manager 8email 18Employee 1800010001
Location 4
100019​
Manager 9email 19Employee 1900000000
Location 5
100020​
Manager 10email 20Employee 2001100110
Location 1
100021​
Manager 1email 21Employee 2100000000
Location 2
100022​
Manager 2email 22Employee 2210101010
Location 3
100023​
Manager 3email 23Employee 2300010001
Location 4
100024​
Manager 4email 24Employee 2400000000
Location 5
100025​
Manager 5email 25Employee 2501000100
Location 1
100026​
Manager 6email 26Employee 2600000000
Location 2
100027​
Manager 7email 27Employee 2710001000
Location 3
100028​
Manager 8email 28Employee 2800000000
Location 4
100029​
Manager 9email 29Employee 2901110111
Location 5
100030​
Manager 10email 30Employee 3000000000

To This:
Sheet 2 Data
Emp IDNameEmailManagerLocationStatusQuestionValue
100001​
Employee 1email 1Manager 1Location 1Full TimeQ10
100001​
Employee 1email 1Manager 1Location 1Full TimeQ20
100001​
Employee 1email 1Manager 1Location 1Full TimeQ30
100001​
Employee 1email 1Manager 1Location 1Full TimeQ41
100001​
Employee 1email 1Manager 1Location 1Part TimeQ50
100001​
Employee 1email 1Manager 1Location 1Part TimeQ60
100001​
Employee 1email 1Manager 1Location 1Part TimeQ70
100001​
Employee 1email 1Manager 1Location 1Part TimeQ81
100002​
Employee 2email 2Manager 2Location 2Full TimeQ10
100002​
Employee 2email 2Manager 2Location 2Full TimeQ20
100002​
Employee 2email 2Manager 2Location 2Full TimeQ31
100002​
Employee 2email 2Manager 2Location 2Full TimeQ40
100002​
Employee 2email 2Manager 2Location 2Part TimeQ50
100002​
Employee 2email 2Manager 2Location 2Part TimeQ60
100002​
Employee 2email 2Manager 2Location 2Part TimeQ71
100002​
Employee 2email 2Manager 2Location 2Part TimeQ80
100003​
Employee 3email 3Manager 3Location 3Full TimeQ10
100003​
Employee 3email 3Manager 3Location 3Full TimeQ21
100003​
Employee 3email 3Manager 3Location 3Full TimeQ30
100003​
Employee 3email 3Manager 3Location 3Full TimeQ40
100003​
Employee 3email 3Manager 3Location 3Part TimeQ50
100003​
Employee 3email 3Manager 3Location 3Part TimeQ61
100003​
Employee 3email 3Manager 3Location 3Part TimeQ70
100003​
Employee 3email 3Manager 3Location 3Part TimeQ80

As you can observe, a single line data on Sheet 1 will be broken into 8 data points once transferred to sheet 2. Also, the order of the rows are changed/reorganized. Would appreciate if the macro can be adjusted to cover more data points on Sheet 1 (probable 5000?). Thanks in advance!!
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

SQUIDD

Well-known Member
Joined
Jan 2, 2009
Messages
1,942
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
HI

So give this a go, on a dummy set of data.

This is assuming that sheet 2 is blank, but has headers.

And the data in sheet 1 we are starting with in in cell B3

and the data is going into sheet 2, starting at A2

VBA Code:
Sub transpose_bespoke()
LR = Range("'SHEET1'!A" & Rows.Count).End(xlUp).Row
For D = 3 To LR
LR1 = Range("'SHEET2'!A" & Rows.Count).End(xlUp).Row + 1
C = 6
For B = LR1 To LR1 + 7
    Sheets("SHEET2").Cells(B, 1) = Sheets("SHEET1").Cells(D, 2)
    Sheets("SHEET2").Cells(B, 2) = Sheets("SHEET1").Cells(D, 5)
    Sheets("SHEET2").Cells(B, 3) = Sheets("SHEET1").Cells(D, 4)
    Sheets("SHEET2").Cells(B, 4) = Sheets("SHEET1").Cells(D, 3)
    Sheets("SHEET2").Cells(B, 5) = Sheets("SHEET1").Cells(D, 1)
    Sheets("SHEET2").Cells(B, 6) = Sheets("SHEET1").Cells(1, C)
    Sheets("SHEET2").Cells(B, 7) = Sheets("SHEET1").Cells(2, C)
    Sheets("SHEET2").Cells(B, 8) = Sheets("SHEET1").Cells(D, C)
    C = C + 1
Next B
Next D
End Sub

Good luck

dave
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
66,064
Office Version
  1. 365
Platform
  1. Windows
Hi & welcome to MrExcel.
How about
VBA Code:
Sub crispangilinan()
   Dim Ary As Variant, Nary As Variant, Cols As Variant
   Dim r As Long, c As Long, nr As Long, nc As Long
   
   Cols = Array("", 2, 5, 4, 3, 1)
   Ary = Sheets("Sheet1").Range("A2").CurrentRegion.Value2
   ReDim Nary(1 To UBound(Ary) * UBound(Ary, 2), 1 To 8)
   For r = 3 To UBound(Ary)
      For c = 6 To UBound(Ary, 2)
         nr = nr + 1
         For nc = 1 To 5
            Nary(nr, nc) = Ary(r, Cols(nc))
         Next nc
         Nary(nr, 6) = Ary(1, c)
         Nary(nr, 7) = Ary(2, c)
         Nary(nr, 8) = Ary(r, c)
      Next c
   Next r
   Sheets("Sheet2").Range("A2").Resize(nr, 8).Value = Nary
End Sub
 
Solution

JamesCanale

Active Member
Joined
Jan 13, 2021
Messages
393
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Office 365 but no macros:
Mr Excel Playground 3.xlsm
ABCDEFGHIJKLMNOPQRSTUV
1Full TimeFull TimeFull TimeFull TimePart TimePart TimePart TimePart Time
2LocationEmp IDManagerEmailNameQ1Q2Q3Q4Q5Q6Q7Q8NameEmailManagerIDLocationStatusQuestionValue
3Location 1100001Manager 1email 1Employee 100010001Employee 1email 1Manager 1100001Location 1Full TimeQ10
4Location 2100002Manager 2email 2Employee 200100010Employee 1email 1Manager 1100001Location 1Full TimeQ20
5Location 3100003Manager 3email 3Employee 301000100Employee 1email 1Manager 1100001Location 1Full TimeQ30
6Location 4100004Manager 4email 4Employee 410111011Employee 1email 1Manager 1100001Location 1Full TimeQ41
7Location 5100005Manager 5email 5Employee 500000000Employee 1email 1Manager 1100001Location 1Part TimeQ50
8Location 1100006Manager 6email 6Employee 600000000Employee 1email 1Manager 1100001Location 1Part TimeQ60
9Location 2100007Manager 7email 7Employee 701010101Employee 1email 1Manager 1100001Location 1Part TimeQ70
10Location 3100008Manager 8email 8Employee 810001000Employee 1email 1Manager 1100001Location 1Part TimeQ81
11Location 4100009Manager 9email 9Employee 900000000Employee 2email 2Manager 2100002Location 2Full TimeQ10
12Location 5100010Manager 10email 10Employee 1001100110Employee 2email 2Manager 2100002Location 2Full TimeQ20
13Location 1100011Manager 1email 11Employee 1100000000Employee 2email 2Manager 2100002Location 2Full TimeQ31
14Location 2100012Manager 2email 12Employee 1200000000Employee 2email 2Manager 2100002Location 2Full TimeQ40
15Location 3100013Manager 3email 13Employee 1300010001Employee 2email 2Manager 2100002Location 2Part TimeQ50
16Location 4100014Manager 4email 14Employee 1400100010Employee 2email 2Manager 2100002Location 2Part TimeQ60
17Location 5100015Manager 5email 15Employee 1501000100Employee 2email 2Manager 2100002Location 2Part TimeQ71
18Location 1100016Manager 6email 16Employee 1610001000Employee 2email 2Manager 2100002Location 2Part TimeQ80
19Location 2100017Manager 7email 17Employee 1700100010Employee 3email 3Manager 3100003Location 3Full TimeQ10
20Location 3100018Manager 8email 18Employee 1800010001Employee 3email 3Manager 3100003Location 3Full TimeQ21
21Location 4100019Manager 9email 19Employee 1900000000Employee 3email 3Manager 3100003Location 3Full TimeQ30
22Location 5100020Manager 10email 20Employee 2001100110Employee 3email 3Manager 3100003Location 3Full TimeQ40
23Location 1100021Manager 1email 21Employee 2100000000Employee 3email 3Manager 3100003Location 3Part TimeQ50
24Location 2100022Manager 2email 22Employee 2210101010Employee 3email 3Manager 3100003Location 3Part TimeQ61
25Location 3100023Manager 3email 23Employee 2300010001Employee 3email 3Manager 3100003Location 3Part TimeQ70
26Location 4100024Manager 4email 24Employee 2400000000Employee 3email 3Manager 3100003Location 3Part TimeQ80
27Location 5100025Manager 5email 25Employee 2501000100Employee 4email 4Manager 4100004Location 4Full TimeQ11
28Location 1100026Manager 6email 26Employee 2600000000Employee 4email 4Manager 4100004Location 4Full TimeQ20
29Location 2100027Manager 7email 27Employee 2710001000Employee 4email 4Manager 4100004Location 4Full TimeQ31
30Location 3100028Manager 8email 28Employee 2800000000Employee 4email 4Manager 4100004Location 4Full TimeQ41
31Location 4100029Manager 9email 29Employee 2901110111Employee 4email 4Manager 4100004Location 4Part TimeQ51
32Location 5100030Manager 10email 30Employee 3000000000Employee 4email 4Manager 4100004Location 4Part TimeQ60
33Employee 4email 4Manager 4100004Location 4Part TimeQ71
34Employee 4email 4Manager 4100004Location 4Part TimeQ81
35Employee 5email 5Manager 5100005Location 5Full TimeQ10
36Employee 5email 5Manager 5100005Location 5Full TimeQ20
37Employee 5email 5Manager 5100005Location 5Full TimeQ30
38Employee 5email 5Manager 5100005Location 5Full TimeQ40
Sheet30
Cell Formulas
RangeFormula
O3:O242O3=INDEX(E3:E32,INT((SEQUENCE(8*COUNTA(A3:A267))+7)/8),1)
P3:P242P3=XLOOKUP(O3#,E3:E32,D3:D32,"",0)
Q3:Q242Q3=XLOOKUP(O3#,E3:E32,C3:C32,"",0)
R3:R242R3=XLOOKUP(O3#,E3:E32,B3:B32,"",0)
S3:S242S3=XLOOKUP(O3#,E3:E32,A3:A32,"",0)
T3:T242T3=INDEX(F1:M1,1,MOD(SEQUENCE(8*COUNTA(A3:A267))-1,8)+1)
U3:U242U3=INDEX(F2:M2,1,MOD(SEQUENCE(8*COUNTA(A3:A267))-1,8)+1)
V3:V242V3=INDEX(F3:M32,INT((SEQUENCE(8*COUNTA(A3:A267))+7)/8),MOD(SEQUENCE(8*COUNTA(A3:A267))-1,8)+1)
Dynamic array formulas.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
66,064
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Another formula option, if you have the LET function
+Fluff 1.xlsm
ABCDEFGH
1Emp IDNameEmailManagerLocationStatusQuestionValue
2100001Employee 1email 1Manager 1Location 1Full TimeQ10
3100001Employee 1email 1Manager 1Location 1Full TimeQ20
4100001Employee 1email 1Manager 1Location 1Full TimeQ30
5100001Employee 1email 1Manager 1Location 1Full TimeQ41
6100001Employee 1email 1Manager 1Location 1Part TimeQ50
7100001Employee 1email 1Manager 1Location 1Part TimeQ60
8100001Employee 1email 1Manager 1Location 1Part TimeQ70
9100001Employee 1email 1Manager 1Location 1Part TimeQ81
10100002Employee 2email 2Manager 2Location 2Full TimeQ10
11100002Employee 2email 2Manager 2Location 2Full TimeQ20
12100002Employee 2email 2Manager 2Location 2Full TimeQ31
13100002Employee 2email 2Manager 2Location 2Full TimeQ40
14100002Employee 2email 2Manager 2Location 2Part TimeQ50
15100002Employee 2email 2Manager 2Location 2Part TimeQ60
16100002Employee 2email 2Manager 2Location 2Part TimeQ71
17100002Employee 2email 2Manager 2Location 2Part TimeQ80
18100003Employee 3email 3Manager 3Location 3Full TimeQ10
19100003Employee 3email 3Manager 3Location 3Full TimeQ21
20100003Employee 3email 3Manager 3Location 3Full TimeQ30
21100003Employee 3email 3Manager 3Location 3Full TimeQ40
22100003Employee 3email 3Manager 3Location 3Part TimeQ50
23100003Employee 3email 3Manager 3Location 3Part TimeQ61
24100003Employee 3email 3Manager 3Location 3Part TimeQ70
25100003Employee 3email 3Manager 3Location 3Part TimeQ80
26100004Employee 4email 4Manager 4Location 4Full TimeQ11
27100004Employee 4email 4Manager 4Location 4Full TimeQ20
28100004Employee 4email 4Manager 4Location 4Full TimeQ31
29100004Employee 4email 4Manager 4Location 4Full TimeQ41
30100004Employee 4email 4Manager 4Location 4Part TimeQ51
Sheet2
Cell Formulas
RangeFormula
A2:E241A2=LET(Rng,Sheet1!A3:E32,Cols,8,Rws,ROWS(Rng),Qty,SEQUENCE(Rws*Cols,,0),SORTBY(INDEX(Rng,INT(Qty/Cols)+1,SEQUENCE(,5)),MATCH(Sheet1!A2:E2,A1:E1,0)))
F2:G241F2=LET(Rng,Sheet1!F1:M2,Cols,COLUMNS(Rng),INDEX(Rng,SEQUENCE(,2),MOD(SEQUENCE(Cols*ROWS(Sheet1!A3:A32),,0),Cols)+1))
H2:H241H2=LET(rng,Sheet1!F3:M32,Cols,COLUMNS(rng),Qty,SEQUENCE(Cols*ROWS(rng),,0),INDEX(rng,INT(Qty/Cols)+1,MOD(Qty,Cols)+1))
Dynamic array formulas.
 
Last edited:

alansidman

Well-known Member
Joined
Feb 26, 2007
Messages
6,668
Office Version
  1. 365
Platform
  1. Windows
An alternative to VBA is Power Query. Here is the Mcode

Power Query:
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Demoted Headers" = Table.DemoteHeaders(Source),
    #"Transposed Table" = Table.Transpose(#"Demoted Headers"),
    #"Merged Columns" = Table.CombineColumns(#"Transposed Table",{"Column1", "Column2"},Combiner.CombineTextByDelimiter(":", QuoteStyle.None),"Merged"),
    #"Transposed Table1" = Table.Transpose(#"Merged Columns"),
    #"Promoted Headers" = Table.PromoteHeaders(#"Transposed Table1", [PromoteAllScalars=true]),
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(#"Promoted Headers", {"Column1:Location", "Column2:Emp ID", "Column3:Manager", "Column4:Email", "Full Time:Name"}, "Attribute", "Value"),
    #"Split Column by Delimiter" = Table.SplitColumn(#"Unpivoted Other Columns", "Attribute", Splitter.SplitTextByDelimiter(":", QuoteStyle.Csv), {"Attribute.1", "Attribute.2"}),
    #"Filtered Rows" = Table.SelectRows(#"Split Column by Delimiter", each Text.StartsWith([Attribute.1], "Full") or Text.StartsWith([Attribute.1], "Part")),
    #"Split Column by Character Transition" = Table.SplitColumn(#"Filtered Rows", "Attribute.1", Splitter.SplitTextByCharacterTransition((c) => not List.Contains({"0".."9"}, c), {"0".."9"}), {"Attribute.1.1", "Attribute.1.2"}),
    #"Removed Columns" = Table.RemoveColumns(#"Split Column by Character Transition",{"Attribute.1.2"}),
    #"Renamed Columns" = Table.RenameColumns(#"Removed Columns",{{"Column2:Emp ID", "ID"}, {"Column1:Location", "Location"}, {"Column3:Manager", "Manager"}, {"Column4:Email", "Email"}, {"Full Time:Name", "Name"}, {"Attribute.1.1", "Status"}, {"Attribute.2", "Question"}}),
    #"Reordered Columns" = Table.ReorderColumns(#"Renamed Columns",{"ID", "Name", "Email", "Location", "Manager", "Status", "Question", "Value"})
in
    #"Reordered Columns"

Book6
ABCDEFGH
1IDNameEmailLocationManagerStatusQuestionValue
2100001Employee 1email 1Location 1Manager 1Full TimeQ10
3100001Employee 1email 1Location 1Manager 1Full TimeQ20
4100001Employee 1email 1Location 1Manager 1Full TimeQ30
5100001Employee 1email 1Location 1Manager 1Part TimeQ41
6100001Employee 1email 1Location 1Manager 1Part TimeQ50
7100001Employee 1email 1Location 1Manager 1Part TimeQ60
8100001Employee 1email 1Location 1Manager 1Part TimeQ70
9100002Employee 2email 2Location 2Manager 2Full TimeQ10
10100002Employee 2email 2Location 2Manager 2Full TimeQ20
11100002Employee 2email 2Location 2Manager 2Full TimeQ31
12100002Employee 2email 2Location 2Manager 2Part TimeQ40
13100002Employee 2email 2Location 2Manager 2Part TimeQ50
14100002Employee 2email 2Location 2Manager 2Part TimeQ60
15100002Employee 2email 2Location 2Manager 2Part TimeQ71
16100003Employee 3email 3Location 3Manager 3Full TimeQ10
17100003Employee 3email 3Location 3Manager 3Full TimeQ21
18100003Employee 3email 3Location 3Manager 3Full TimeQ30
19100003Employee 3email 3Location 3Manager 3Part TimeQ40
20100003Employee 3email 3Location 3Manager 3Part TimeQ50
21100003Employee 3email 3Location 3Manager 3Part TimeQ61
22100003Employee 3email 3Location 3Manager 3Part TimeQ70
Table1


Only showing first three employees. File runs 200 lines plus
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
66,064
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Or, just for the fun of it, one (rather long) formula
+Fluff 1.xlsm
ABCDEFGH
1Emp IDNameEmailManagerLocationStatusQuestionValue
2100001Employee 1email 1Manager 1Location 1Full TimeQ10
3100001Employee 1email 1Manager 1Location 1Full TimeQ20
4100001Employee 1email 1Manager 1Location 1Full TimeQ30
5100001Employee 1email 1Manager 1Location 1Full TimeQ41
6100001Employee 1email 1Manager 1Location 1Part TimeQ50
7100001Employee 1email 1Manager 1Location 1Part TimeQ60
8100001Employee 1email 1Manager 1Location 1Part TimeQ70
9100001Employee 1email 1Manager 1Location 1Part TimeQ81
10100002Employee 2email 2Manager 2Location 2Full TimeQ10
11100002Employee 2email 2Manager 2Location 2Full TimeQ20
12100002Employee 2email 2Manager 2Location 2Full TimeQ31
13100002Employee 2email 2Manager 2Location 2Full TimeQ40
14100002Employee 2email 2Manager 2Location 2Part TimeQ50
15100002Employee 2email 2Manager 2Location 2Part TimeQ60
16100002Employee 2email 2Manager 2Location 2Part TimeQ71
17100002Employee 2email 2Manager 2Location 2Part TimeQ80
18100003Employee 3email 3Manager 3Location 3Full TimeQ10
19100003Employee 3email 3Manager 3Location 3Full TimeQ21
20100003Employee 3email 3Manager 3Location 3Full TimeQ30
21100003Employee 3email 3Manager 3Location 3Full TimeQ40
22100003Employee 3email 3Manager 3Location 3Part TimeQ50
23100003Employee 3email 3Manager 3Location 3Part TimeQ61
24100003Employee 3email 3Manager 3Location 3Part TimeQ70
25100003Employee 3email 3Manager 3Location 3Part TimeQ80
26100004Employee 4email 4Manager 4Location 4Full TimeQ11
27100004Employee 4email 4Manager 4Location 4Full TimeQ20
28100004Employee 4email 4Manager 4Location 4Full TimeQ31
29100004Employee 4email 4Manager 4Location 4Full TimeQ41
30100004Employee 4email 4Manager 4Location 4Part TimeQ51
Sheet2
Cell Formulas
RangeFormula
A2:H241A2=LET(RngA,Sheet1!A3:E32,RngB,Sheet1!F1:M2,RngC,Sheet1!F3:M32,Cols,COLUMNS(RngB),Rws,ROWS(RngA),Qty,SEQUENCE(Rws*Cols,,0),aryA,SORTBY(INDEX(RngA,INT(Qty/Cols)+1,SEQUENCE(,5)),MATCH(Sheet1!A2:E2,A1:E1,0)),aryB,INDEX(RngB,SEQUENCE(,2),MOD(SEQUENCE(Cols*ROWS(Sheet1!A3:A32),,0),Cols)+1),aryC,INDEX(RngC,INT(Qty/Cols)+1,MOD(Qty,Cols)+1),CHOOSE(SEQUENCE(,8),aryA,aryA,aryA,aryA,aryA,INDEX(aryB,,1),INDEX(aryB,,2),aryC))
Dynamic array formulas.
 

crispangilinan

New Member
Joined
Sep 16, 2021
Messages
4
Office Version
  1. 365
  2. 2019
  3. 2016
Or, just for the fun of it, one (rather long) formula
+Fluff 1.xlsm
ABCDEFGH
1Emp IDNameEmailManagerLocationStatusQuestionValue
2100001Employee 1email 1Manager 1Location 1Full TimeQ10
3100001Employee 1email 1Manager 1Location 1Full TimeQ20
4100001Employee 1email 1Manager 1Location 1Full TimeQ30
5100001Employee 1email 1Manager 1Location 1Full TimeQ41
6100001Employee 1email 1Manager 1Location 1Part TimeQ50
7100001Employee 1email 1Manager 1Location 1Part TimeQ60
8100001Employee 1email 1Manager 1Location 1Part TimeQ70
9100001Employee 1email 1Manager 1Location 1Part TimeQ81
10100002Employee 2email 2Manager 2Location 2Full TimeQ10
11100002Employee 2email 2Manager 2Location 2Full TimeQ20
12100002Employee 2email 2Manager 2Location 2Full TimeQ31
13100002Employee 2email 2Manager 2Location 2Full TimeQ40
14100002Employee 2email 2Manager 2Location 2Part TimeQ50
15100002Employee 2email 2Manager 2Location 2Part TimeQ60
16100002Employee 2email 2Manager 2Location 2Part TimeQ71
17100002Employee 2email 2Manager 2Location 2Part TimeQ80
18100003Employee 3email 3Manager 3Location 3Full TimeQ10
19100003Employee 3email 3Manager 3Location 3Full TimeQ21
20100003Employee 3email 3Manager 3Location 3Full TimeQ30
21100003Employee 3email 3Manager 3Location 3Full TimeQ40
22100003Employee 3email 3Manager 3Location 3Part TimeQ50
23100003Employee 3email 3Manager 3Location 3Part TimeQ61
24100003Employee 3email 3Manager 3Location 3Part TimeQ70
25100003Employee 3email 3Manager 3Location 3Part TimeQ80
26100004Employee 4email 4Manager 4Location 4Full TimeQ11
27100004Employee 4email 4Manager 4Location 4Full TimeQ20
28100004Employee 4email 4Manager 4Location 4Full TimeQ31
29100004Employee 4email 4Manager 4Location 4Full TimeQ41
30100004Employee 4email 4Manager 4Location 4Part TimeQ51
Sheet2
Cell Formulas
RangeFormula
A2:H241A2=LET(RngA,Sheet1!A3:E32,RngB,Sheet1!F1:M2,RngC,Sheet1!F3:M32,Cols,COLUMNS(RngB),Rws,ROWS(RngA),Qty,SEQUENCE(Rws*Cols,,0),aryA,SORTBY(INDEX(RngA,INT(Qty/Cols)+1,SEQUENCE(,5)),MATCH(Sheet1!A2:E2,A1:E1,0)),aryB,INDEX(RngB,SEQUENCE(,2),MOD(SEQUENCE(Cols*ROWS(Sheet1!A3:A32),,0),Cols)+1),aryC,INDEX(RngC,INT(Qty/Cols)+1,MOD(Qty,Cols)+1),CHOOSE(SEQUENCE(,8),aryA,aryA,aryA,aryA,aryA,INDEX(aryB,,1),INDEX(aryB,,2),aryC))
Dynamic array formulas.
Thanks so much!
 

crispangilinan

New Member
Joined
Sep 16, 2021
Messages
4
Office Version
  1. 365
  2. 2019
  3. 2016
An alternative to VBA is Power Query. Here is the Mcode

Power Query:
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Demoted Headers" = Table.DemoteHeaders(Source),
    #"Transposed Table" = Table.Transpose(#"Demoted Headers"),
    #"Merged Columns" = Table.CombineColumns(#"Transposed Table",{"Column1", "Column2"},Combiner.CombineTextByDelimiter(":", QuoteStyle.None),"Merged"),
    #"Transposed Table1" = Table.Transpose(#"Merged Columns"),
    #"Promoted Headers" = Table.PromoteHeaders(#"Transposed Table1", [PromoteAllScalars=true]),
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(#"Promoted Headers", {"Column1:Location", "Column2:Emp ID", "Column3:Manager", "Column4:Email", "Full Time:Name"}, "Attribute", "Value"),
    #"Split Column by Delimiter" = Table.SplitColumn(#"Unpivoted Other Columns", "Attribute", Splitter.SplitTextByDelimiter(":", QuoteStyle.Csv), {"Attribute.1", "Attribute.2"}),
    #"Filtered Rows" = Table.SelectRows(#"Split Column by Delimiter", each Text.StartsWith([Attribute.1], "Full") or Text.StartsWith([Attribute.1], "Part")),
    #"Split Column by Character Transition" = Table.SplitColumn(#"Filtered Rows", "Attribute.1", Splitter.SplitTextByCharacterTransition((c) => not List.Contains({"0".."9"}, c), {"0".."9"}), {"Attribute.1.1", "Attribute.1.2"}),
    #"Removed Columns" = Table.RemoveColumns(#"Split Column by Character Transition",{"Attribute.1.2"}),
    #"Renamed Columns" = Table.RenameColumns(#"Removed Columns",{{"Column2:Emp ID", "ID"}, {"Column1:Location", "Location"}, {"Column3:Manager", "Manager"}, {"Column4:Email", "Email"}, {"Full Time:Name", "Name"}, {"Attribute.1.1", "Status"}, {"Attribute.2", "Question"}}),
    #"Reordered Columns" = Table.ReorderColumns(#"Renamed Columns",{"ID", "Name", "Email", "Location", "Manager", "Status", "Question", "Value"})
in
    #"Reordered Columns"

Book6
ABCDEFGH
1IDNameEmailLocationManagerStatusQuestionValue
2100001Employee 1email 1Location 1Manager 1Full TimeQ10
3100001Employee 1email 1Location 1Manager 1Full TimeQ20
4100001Employee 1email 1Location 1Manager 1Full TimeQ30
5100001Employee 1email 1Location 1Manager 1Part TimeQ41
6100001Employee 1email 1Location 1Manager 1Part TimeQ50
7100001Employee 1email 1Location 1Manager 1Part TimeQ60
8100001Employee 1email 1Location 1Manager 1Part TimeQ70
9100002Employee 2email 2Location 2Manager 2Full TimeQ10
10100002Employee 2email 2Location 2Manager 2Full TimeQ20
11100002Employee 2email 2Location 2Manager 2Full TimeQ31
12100002Employee 2email 2Location 2Manager 2Part TimeQ40
13100002Employee 2email 2Location 2Manager 2Part TimeQ50
14100002Employee 2email 2Location 2Manager 2Part TimeQ60
15100002Employee 2email 2Location 2Manager 2Part TimeQ71
16100003Employee 3email 3Location 3Manager 3Full TimeQ10
17100003Employee 3email 3Location 3Manager 3Full TimeQ21
18100003Employee 3email 3Location 3Manager 3Full TimeQ30
19100003Employee 3email 3Location 3Manager 3Part TimeQ40
20100003Employee 3email 3Location 3Manager 3Part TimeQ50
21100003Employee 3email 3Location 3Manager 3Part TimeQ61
22100003Employee 3email 3Location 3Manager 3Part TimeQ70
Table1


Only showing first three employees. File runs 200 lines plus
Thanks so much!
 

crispangilinan

New Member
Joined
Sep 16, 2021
Messages
4
Office Version
  1. 365
  2. 2019
  3. 2016
Hi & welcome to MrExcel.
How about
VBA Code:
Sub crispangilinan()
   Dim Ary As Variant, Nary As Variant, Cols As Variant
   Dim r As Long, c As Long, nr As Long, nc As Long
  
   Cols = Array("", 2, 5, 4, 3, 1)
   Ary = Sheets("Sheet1").Range("A2").CurrentRegion.Value2
   ReDim Nary(1 To UBound(Ary) * UBound(Ary, 2), 1 To 8)
   For r = 3 To UBound(Ary)
      For c = 6 To UBound(Ary, 2)
         nr = nr + 1
         For nc = 1 To 5
            Nary(nr, nc) = Ary(r, Cols(nc))
         Next nc
         Nary(nr, 6) = Ary(1, c)
         Nary(nr, 7) = Ary(2, c)
         Nary(nr, 8) = Ary(r, c)
      Next c
   Next r
   Sheets("Sheet2").Range("A2").Resize(nr, 8).Value = Nary
End Sub
Wow works like magic!
 

Forum statistics

Threads
1,148,364
Messages
5,746,276
Members
424,003
Latest member
paaskanama

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top