Transpose Values VBA for week

mahmed1

Well-known Member
Joined
Mar 28, 2009
Messages
2,222
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi All,

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

AreaDateMonTueWedThuFriSatSunTotal
Team 120-07-2014372032343524196
Team 127-07-204846364810216206
Team 220-07-203831421610103150
Team 227-07-2033151519314727187


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

AreaDateIncoming
Team 120/07/202014
Team 121/07/202037
Team 122/07/202020
Team 123/07/202032
Team 124/07/202034
Team 125/07/202035
Team 126/07/202024
Team 127/07/202048
Team 128/07/202046
Team 129/07/202036
Team 130/07/202048
Team 131/07/202010
Team 101/08/20202
Team 102/08/202016
Team220/07/202038
Team221/07/202031
Team222/07/202042
Team223/07/202016
Team224/07/202010
Team225/07/202010
Team226/07/20203
Team227/07/202033
Team228/07/202015
Team229/07/202015
Team230/07/202019
Team231/07/202031
Team201/08/202047
Team202/08/202027


My Sheet is called Data and the headings start from A1

Many Thanks
 

Some videos you may like

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,117
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
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

Well-known Member
Joined
Mar 28, 2009
Messages
2,222
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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

Well-known Member
Joined
Mar 28, 2009
Messages
2,222
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I know Ubound(Ary) will give total amount of rows
You then multiply by Ubound(Ary,2)?
 

Fluff

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

ADVERTISEMENT

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

Well-known Member
Joined
Mar 28, 2009
Messages
2,222
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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

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

ADVERTISEMENT

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

mahmed1

Well-known Member
Joined
Mar 28, 2009
Messages
2,222
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,117
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 

mahmed1

Well-known Member
Joined
Mar 28, 2009
Messages
2,222
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
BTW is this the right way to do it or would you approach it differently?

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

Watch MrExcel Video

Forum statistics

Threads
1,122,915
Messages
5,598,850
Members
414,263
Latest member
sherrcha

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