Transpose Values VBA for week

[mahmed1]

Hi All,

I have a data set that is stored like this (I dont need total in output)

Area	Date	Mon	Tue	Wed	Thu	Fri	Sat	Sun	Total
Team 1	20-07-20	14	37	20	32	34	35	24	196
Team 1	27-07-20	48	46	36	48	10	2	16	206
Team 2	20-07-20	38	31	42	16	10	10	3	150
Team 2	27-07-20	33	15	15	19	31	47	27	187

How can i use VBA to transpose the information in a tabular format like below

Area	Date	Incoming
Team 1	20/07/2020	14
Team 1	21/07/2020	37
Team 1	22/07/2020	20
Team 1	23/07/2020	32
Team 1	24/07/2020	34
Team 1	25/07/2020	35
Team 1	26/07/2020	24
Team 1	27/07/2020	48
Team 1	28/07/2020	46
Team 1	29/07/2020	36
Team 1	30/07/2020	48
Team 1	31/07/2020	10
Team 1	01/08/2020	2
Team 1	02/08/2020	16
Team2	20/07/2020	38
Team2	21/07/2020	31
Team2	22/07/2020	42
Team2	23/07/2020	16
Team2	24/07/2020	10
Team2	25/07/2020	10
Team2	26/07/2020	3
Team2	27/07/2020	33
Team2	28/07/2020	15
Team2	29/07/2020	15
Team2	30/07/2020	19
Team2	31/07/2020	31
Team2	01/08/2020	47
Team2	02/08/2020	27

My Sheet is called Data and the headings start from A1

Many Thanks

 

[Fluff]

How about

Sub mahmed()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, nr As Long, c As Long
   
   Ary = Sheets("Data").Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To UBound(Ary) * UBound(Ary, 2), 1 To 3)
   
   For r = 2 To UBound(Ary)
      For c = 3 To UBound(Ary, 2) - 1
         nr = nr + 1
         Nary(nr, 1) = Ary(r, 1)
         Nary(nr, 2) = Ary(r, 2) + c - 3
         Nary(nr, 3) = Ary(r, c)
      Next c
   Next r
   Sheets("Data").Range("M2").Resize(nr, 3).Value = Nary
End Sub

This will put the output starting in M2

 

[mahmed1]

Awesome will give this a go
Thank u - that was quick

can explain this part of the array please

ReDim Nary(1 To UBound(Ary) * UBound(Ary, 2), 1 To 3)

Nary(nr, 1) = Ary(r, 1)
Nary(nr, 2) = Ary(r, 2) + c - 3
Nary(nr, 3) = Ary(r, c)

Just trying to understand how that part works

thank you

 

[mahmed1]

I know Ubound(Ary) will give total amount of rows
You then multiply by Ubound(Ary,2)?

 

[Fluff]

Ubound(Ary,2) gives the total number of columns, that is multiplied by the number of rows to give an array that will be large enough to handle the data.

 

[mahmed1]

Ah ok - nice way of doing it - would never had thought of that

thank you

il give that a go - would it cause to much of an issue to the code if i just copied the data and not the header row as my paste area which is row on PasteSheet has the headers already in row 1 (ie Area, Date, Incoming)
This is a table called tbl_Incoming so each time i paste the data by transposing it - i will need to clear the table contents and paste into A2

thank you again - so quick with ur response- really appreciate it

 

[Fluff]

The code does not copy the headers, just the data.

 

[mahmed1]

Awesome - thank you so before pasting - i would need to delete the table databodyrange and then resize it

Ive applied this code

thisworkbook.worksheet(“PasteSheet”).listobjects(“tblIncoming”).Databodyrange.delete

paste the data in A2
resize table

again thank you for ur speedy help

 

[Fluff]

You're welcome & thanks for the feedback.

 

[mahmed1]

BTW is this the right way to do it or would you approach it differently?

thisworkbook.worksheet(“PasteSheet”).listobjects(“tblIncoming”).Databodyrange.delete