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]

Yup you can do that.
Assuming the table starts in A1
you can use

   With Sheets("Pastesheet").ListObjects("tblIncoming")
      .DataBodyRange.Delete
      .Parent.Range("A2").Resize(nr, 3).Value = Nary
   End With

 

[mahmed1]

Legend- thank you

 

[Fluff]

You're welcome & thanks for the feedback.

 

[mahmed1]

Hi Again bud - ive been asked to split this data further by half hour period - is this something you can please help me with

So once the data is transposed by day split it like this and the value Stays the same for each interval from 00:00, 00:30,01:00...23:30

Eg..

Team Date Period Incoming
Team1 01/01/2020 00:00 48
Team1 01/01/2020 00:30 48.
Team1 01/01/2020 01:00 48.....
Team1 01/01/2020 23:30 48
Team2 01/01/2020 00:00 55
Team2 01/01/2020 00:30 55....
Team2 01/01/2020 23:30 55

so plan is to in the 3rd column have the half hour slot for whole day as part of the code and split like above .... thank you so much

 

[Fluff]

That is a totally different question, so needs a new thread. Thanks

 

[mahmed1]

Ok thank you will create a new thread now

thank you

 

[Fluff]

 

[mahmed1]

I have tried to follow up the question in the other thread but not sure if ive been clear enough as its a follow up to add at the end of this code

again thank you

 

[mahmed1]

Hi Fluff - i've tried your code - it worked fine until i added a couple of extra columns at the end of total (ID and Type)

So my source data header is like this

I still dont need Total but the output will be like these headers

This was my amended code

Sub UpdateData()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, nr As Long, c As Long
   
   Ary = Sheets("TempData").Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To UBound(Ary) * UBound(Ary, 2), 1 To 5)
   
   For r = 2 To UBound(Ary)
      For c = 3 To UBound(Ary, 2) - 1
         nr = nr + 1
         Nary(nr, 1) = Ary(r, 2) + c - 3
         Nary(nr, 2) = Ary(r, 1)
         Nary(nr, 3) = Ary(r, c)
         Nary(nr, 4) = Ary(r, 11)
         Nary(nr, 5) = Ary(r, 12)
      Next c
   Next r
   
    With Sheets("Forecast_Volumes").ListObjects("tbl_Forecast")
      .DataBodyRange.Delete
      .Parent.Range("A2").Resize(nr, 5).Value = Nary
    End With
    
End Sub

 

[Fluff]

Can you post some new sample data.