Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Old August 10th 17, 01:01 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Aug 2012
Posts: 137
Default Assistance in transposing multiple sets of data

Hi Team

I have been given a monumental task to change a file from its existing format to more of a Transposed version which will literally take hours, if not days to do manually so here I am again asking for help.

Existing format: ( Sheet 1 )

There are 2 sets of data in each Weekly Group: ( Monday to Saturday ).

Group .1
Set .1 = Column A = Unit No, then 6 groups of ( 5 columns x 14 rows ) - starting @ B9

e.g

Monday = B9:F22... Tuesday = G9:K22 etc to Saturday = AA9:AE22

A B C D E F
7__Monday, 26 June 2017
8__Trucks___HrsTot HrsIdle HrsActive Loads Rev/Cost
9__C001_____15.25_______________15.25________6____ _____________________
10_C002___________________________________________ _____________________
11_C003______9.50________________9.50________3____ _____________________
12_C004______8.25________________8.25________3____ _____________________
13_C005_____18.00______3.50_____14.50________5____ _____________________
14_C006_____10.75_______________10.75________3____ _____________________
15_C007_____10.75_______________10.75________3____ _____________________
16_C008______9.25________________9.25________3____ _____________________
17_C009______8.00______1.00______7.00________2____ _____________________
18_C010_____10.00_______________10.00________3____ _____________________
19_C011_____10.00_______________10.00________3____ _____________________
20_C012______9.75________________9.75________2____ _____________________
21_C013______9.00________________9.00________3____ _____________________
22_C014___________________________________________ _____________________

Set .2 = Column A = Unit No, then 6 groups of ( 5 columns x 20 rows ) – starting @ B27

27_S001_____10.00_______________10.00________3____ _________
28_S002______9.75________________9.75________2____ _________
29_S003______9.00________________9.00________3____ _________
30_S004___________________________________________ _________
Etc......

Each set is recursive in that for each Weekly Group there is the same format for data entry.

The next weeks data:

Group .2
Set .1 = 5 columns x 14 rows - starting @ B55
Set .2 = 5 columns x 20 rows - starting @ B73

And the spacing for each consecutive sets of data are exactly the same 46 rows.

Required Format: ( Sheet 2 )

_____A________B________C_______D_________E________ _F__________G_______________
1___Date_____Unit____HrsTot__HrsIdle__HrsActive___ Loads____Rev/Cost___________
2__26/6/17___C001____15.25_____0_______15.25_______6______ ___0.00_____________
3__26/6/17___C002_____0.00_____0________0.00_______0______ ___0.00_____________
4__Etc.....

As always, much appreciation in advance
Kind regards
Mark.

  #2   Report Post  
Old August 10th 17, 03:07 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Apr 2011
Posts: 3,542
Default Assistance in transposing multiple sets of data

Hi Mark,

Am Thu, 10 Aug 2017 05:01:07 -0700 (PDT) schrieb Living the Dream:

Required Format: ( Sheet 2 )

_____A________B________C_______D_________E________ _F__________G_______________
1___Date_____Unit____HrsTot__HrsIdle__HrsActive___ Loads____Rev/Cost___________
2__26/6/17___C001____15.25_____0_______15.25_______6______ ___0.00_____________
3__26/6/17___C002_____0.00_____0________0.00_______0______ ___0.00_____________
4__Etc.....


I don't know if I understood your table layout correctly.
Try:

Sub TransposeTable()
Dim rng1 As Range, rng2 As Range
Dim i As Integer, rowsC1 As Integer, rowsC2 As Integer
Dim Lrow As Long, j As Long

With Sheets("Sheet1")
Lrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For j = 9 To Lrow Step 48
For i = 1 To 31 Step 6
Set rng1 = .Range(.Cells(j, i), .Cells(j + 13, i + 5))
Set rng2 = .Range(.Cells(j + 18, i), .Cells(j + 37, i + 5))
rowsC1 = rng1.Rows.Count
rowsC2 = rng2.Rows.Count
Sheets("Sheet2").Cells(Rows.Count, "B").End(xlUp)(2) _
.Resize(rowsC1, 6).Value = rng1.Value
Sheets("Sheet2").Cells(Rows.Count, "B").End(xlUp)(2) _
.Resize(rowsC2, 6).Value = rng2.Value
Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp)(2) _
.Resize(rowsC1 + rowsC2) = .Cells(j - 2, i)
Next
Next
End With
End Sub


Regards
Claus B.
--
Windows10
Office 2016
  #3   Report Post  
Old August 11th 17, 12:06 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Aug 2012
Posts: 137
Default Assistance in transposing multiple sets of data

Hi Claus

Once again, thank you for your assistance.

I ran your code and it worked kind of, but I think it did not work in-part because I did not fully express exactly what I was trying to achieve.

Below is a breakdown of just ( week 1 ) what I am attempting to do, the Step spacing remains the same.

With Sheets("Sheet1")

'Company Trucks
'_________________________________________________ ______________________________

'Copy Date Week .1 - Monday
With Range("B7")
.Copy Destination:=Sheets("Sheet2").Range("A2:A15").Past eValue
End With
'Copy Units
With Range("A9:A22")
.Copy Destination:=Sheets("Sheet2").Range("B2").PasteVal ue
End With
'Copy Data Week .1 - Monday
With Range("B9:F22")
.Copy Destination:=Sheets("Sheet2").Range("C2").PasteVal ue
End With

'Copy Date Week .1 - Tuesday
With Range("G7")
.Copy Destination:=Sheets("Sheet2").Range("A16:A29").Pas teValue
End With
'Copy Units
With Range("A9:A22")
.Copy Destination:=Sheets("Sheet2").Range("B16").PasteVa lue
End With
'Copy Data Week .1 - Tuesday
With Range("G9:K22")
.Copy Destination:=Sheets("Sheet2").Range("C16").PasteVa lue
End With

'Copy Date Week .1 - Wednesday
With Range("L7")
.Copy Destination:=Sheets("Sheet2").Range("A30:A43").Pas teValue
End With
'Copy Units
With Range("A9:A22")
.Copy Destination:=Sheets("Sheet2").Range("B30").PasteVa lue
End With
'Copy Data Week .1 - Wednesday
With Range("L9:P22")
.Copy Destination:=Sheets("Sheet2").Range("C30").PasteVa lue
End With

'Copy Date Week .1 - Thursday
With Range("Q7")
.Copy Destination:=Sheets("Sheet2").Range("A44:A57").Pas teValue
End With
'Copy Units
With Range("A9:A22")
.Copy Destination:=Sheets("Sheet2").Range("B44").PasteVa lue
End With
'Copy Data Week .1 - Thursday
With Range("Q9:P22")
.Copy Destination:=Sheets("Sheet2").Range("C44").PasteVa lue
End With

'Copy Date Week .1 - Friday
With Range("V7")
.Copy Destination:=Sheets("Sheet2").Range("A58:A71").Pas teValue
End With
'Copy Units
With Range("A9:A22")
.Copy Destination:=Sheets("Sheet2").Range("B58").PasteVa lue
End With
'Copy Data Week .1 - Friday
With Range("V9:Z22")
.Copy Destination:=Sheets("Sheet2").Range("C58").PasteVa lue
End With

'Copy Date Week .1 - Saturday
With Range("AA7")
.Copy Destination:=Sheets("Sheet2").Range("A72:A85").Pas teValue
End With
'Copy Units
With Range("A9:A22")
.Copy Destination:=Sheets("Sheet2").Range("B72").PasteVa lue
End With
'Copy Data Week .1 - Saturday
With Range("AA9:AE22")
.Copy Destination:=Sheets("Sheet2").Range("C72").PasteVa lue
End With

'_________________________________________________ _________________________________________

'Sub-contractor Trucks
'_________________________________________________ ______________________________

'Copy Date Week .1 - Monday
With Range("B7")
.Copy Destination:=Sheets("Sheet2").Range("A86:A105").Pa steValue
End With
'Copy Units
With Range("A27:A46")
.Copy Destination:=Sheets("Sheet2").Range("B86").PasteVa lue
End With
'Copy Data Week .1 - Monday
With Range("B27:F46")
.Copy Destination:=Sheets("Sheet2").Range("C86").PasteVa lue
End With

'Copy Date Week .1 - Tuesday
With Range("G7")
.Copy Destination:=Sheets("Sheet2").Range("A106:A125").P asteValue
End With
'Copy Units
With Range("A27:A46")
.Copy Destination:=Sheets("Sheet2").Range("B106").PasteV alue
End With
'Copy Data Week .1 - Tuesday
With Range("G27:K46")
.Copy Destination:=Sheets("Sheet2").Range("C106").PasteV alue
End With

'Copy Date Week .1 - Wednesday
With Range("L7")
.Copy Destination:=Sheets("Sheet2").Range("A126:A145").P asteValue
End With
'Copy Units
With Range("A27:A46")
.Copy Destination:=Sheets("Sheet2").Range("B126").PasteV alue
End With
'Copy Data Week .1 - Wednesday
With Range("L27:P46")
.Copy Destination:=Sheets("Sheet2").Range("C126").PasteV alue
End With

'Copy Date Week .1 - Thursday
With Range("Q7")
.Copy Destination:=Sheets("Sheet2").Range("A146:A165").P asteValue
End With
'Copy Units
With Range("A27:A46")
.Copy Destination:=Sheets("Sheet2").Range("B146").PasteV alue
End With
'Copy Data Week .1 - Thursday
With Range("Q27:P46")
.Copy Destination:=Sheets("Sheet2").Range("C146").PasteV alue
End With

'Copy Date Week .1 - Friday
With Range("V7")
.Copy Destination:=Sheets("Sheet2").Range("A166:A185").P asteValue
End With
'Copy Units
With Range("A27:A46")
.Copy Destination:=Sheets("Sheet2").Range("B166").PasteV alue
End With
'Copy Data Week .1 - Friday
With Range("V27:Z46")
.Copy Destination:=Sheets("Sheet2").Range("C166").PasteV alue
End With

'Copy Date Week .1 - Saturday
With Range("AA7")
.Copy Destination:=Sheets("Sheet2").Range("A186:A205").P asteValue
End With
'Copy Units
With Range("A27:A46")
.Copy Destination:=Sheets("Sheet2").Range("B186").PasteV alue
End With
'Copy Data Week .1 - Saturday
With Range("AA27:AE46")
.Copy Destination:=Sheets("Sheet2").Range("C186").PasteV alue
End With

'_________________________________________________ _________________________________________


End With
End Sub


Once again

Thank you so much for your time.
Cheers
Mark.
  #4   Report Post  
Old August 11th 17, 12:36 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Apr 2011
Posts: 3,542
Default Assistance in transposing multiple sets of data

Hi Mark,

Am Fri, 11 Aug 2017 04:06:51 -0700 (PDT) schrieb Living the Dream:

I ran your code and it worked kind of, but I think it did not work in-part because I did not fully express exactly what I was trying to achieve.

Below is a breakdown of just ( week 1 ) what I am attempting to do, the Step spacing remains the same.


try:

Sub TransposeTable()
Dim rng1 As Range
Dim i As Integer, rowsC1 As Integer
Dim Lrow As Long, j As Long
Dim varRows As Variant

varRows = Array(9, 27, 57, 75) 'the start rows of the groups

With Sheets("Sheet1")
Lrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For j = LBound(varRows) To UBound(varRows) 'loop through the rows
For i = 1 To 31 Step 6 'loop through the columns
Set rng1 = .Cells(varRows(j), i).Resize(IIf(Application.IsEven(j), 14, 20), 6)
rowsC1 = rng1.Rows.Count
Sheets("Sheet2").Cells(Rows.Count, "B").End(xlUp)(2) _
.Resize(rowsC1, 6).Value = rng1.Value '
Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp)(2) _
.Resize(rowsC1) = .Cells(varRows(j) - IIf(Application.IsEven(j), 2, 20), i + 1)
Next
Next
End With
End Sub

If the code doesn't work for you send me a mail. Then I send you my
workbook. You can look if the layout differs and modify the steps as
expected.


Regards
Claus B.
--
Windows10
Office 2016
  #5   Report Post  
Old August 11th 17, 01:05 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Aug 2012
Posts: 137
Default Assistance in transposing multiple sets of data

Hi Claus

Again, fairly close but not quite.

I just ran this and it did the whole first week perfectly.

Now just need to loop it through all 53 weeks and multiple workbooks..

Thank you again.

It's not pretty, but it worked.

With Sheets("Sheet1").Range("B7")
.Copy
Sheets("Sheet2").Range("A2:A15").PasteSpecial Paste:=xlValues
End With
'Copy Units
With Sheets("Sheet1").Range("A9:A22")
.Copy
Sheets("Sheet2").Range("B2").PasteSpecial Paste:=xlValues
End With
'Copy Data Week .1 - Monday
With Sheets("Sheet1").Range("B9:F22")
.Copy
Sheets("Sheet2").Range("C2").PasteSpecial Paste:=xlValues
End With

'Copy Date Week .1 - Tuesday
With Sheets("Sheet1").Range("G7")
.Copy
Sheets("Sheet2").Range("A16:A29").PasteSpecial Paste:=xlValues
End With
'Copy Units
With Sheets("Sheet1").Range("A9:A22")
.Copy
Sheets("Sheet2").Range("B16").PasteSpecial Paste:=xlValues
End With
'Copy Data Week .1 - Tuesday
With Sheets("Sheet1").Range("G9:K22")
.Copy
Sheets("Sheet2").Range("C16").PasteSpecial Paste:=xlValues
End With

'Copy Date Week .1 - Wednesday
With Sheets("Sheet1").Range("L7")
.Copy
Sheets("Sheet2").Range("A30:A43").PasteSpecial Paste:=xlValues
End With
'Copy Units
With Sheets("Sheet1").Range("A9:A22")
.Copy
Sheets("Sheet2").Range("B30").PasteSpecial Paste:=xlValues
End With
'Copy Data Week .1 - Wednesday
With Sheets("Sheet1").Range("L9:P22")
.Copy
Sheets("Sheet2").Range("C30").PasteSpecial Paste:=xlValues
End With

'Copy Date Week .1 - Thursday
With Sheets("Sheet1").Range("Q7")
.Copy
Sheets("Sheet2").Range("A44:A57").PasteSpecial Paste:=xlValues
End With
'Copy Units
With Sheets("Sheet1").Range("A9:A22")
.Copy
Sheets("Sheet2").Range("B44").PasteSpecial Paste:=xlValues
End With
'Copy Data Week .1 - Thursday
With Sheets("Sheet1").Range("Q9:U22")
.Copy
Sheets("Sheet2").Range("C44").PasteSpecial Paste:=xlValues
End With

'Copy Date Week .1 - Friday
With Sheets("Sheet1").Range("V7")
.Copy
Sheets("Sheet2").Range("A58:A71").PasteSpecial Paste:=xlValues
End With
'Copy Units
With Sheets("Sheet1").Range("A9:A22")
.Copy
Sheets("Sheet2").Range("B58").PasteSpecial Paste:=xlValues
End With
'Copy Data Week .1 - Friday
With Sheets("Sheet1").Range("V9:Z22")
.Copy
Sheets("Sheet2").Range("C58").PasteSpecial Paste:=xlValues
End With

'Copy Date Week .1 - Saturday
With Sheets("Sheet1").Range("AA7")
.Copy
Sheets("Sheet2").Range("A72:A85").PasteSpecial Paste:=xlValues
End With
'Copy Units
With Sheets("Sheet1").Range("A9:A22")
.Copy
Sheets("Sheet2").Range("B72").PasteSpecial Paste:=xlValues
End With
'Copy Data Week .1 - Saturday
With Sheets("Sheet1").Range("AA9:AE22")
.Copy
Sheets("Sheet2").Range("C72").PasteSpecial Paste:=xlValues
End With

'_________________________________________________ _________________________________________

'Sub-contractor Trucks
'_________________________________________________ ______________________________

'Copy Date Week .1 - Monday
With Sheets("Sheet1").Range("B7")
.Copy
Sheets("Sheet2").Range("A86:A105").PasteSpecial Paste:=xlValues
End With
'Copy Units
With Sheets("Sheet1").Range("A27:A46")
.Copy
Sheets("Sheet2").Range("B86").PasteSpecial Paste:=xlValues
End With
'Copy Data Week .1 - Monday
With Sheets("Sheet1").Range("B27:F46")
.Copy
Sheets("Sheet2").Range("C86").PasteSpecial Paste:=xlValues
End With

'Copy Date Week .1 - Tuesday
With Sheets("Sheet1").Range("G7")
.Copy
Sheets("Sheet2").Range("A106:A125").PasteSpecial Paste:=xlValues
End With
'Copy Units
With Sheets("Sheet1").Range("A27:A46")
.Copy
Sheets("Sheet2").Range("B106").PasteSpecial Paste:=xlValues
End With
'Copy Data Week .1 - Tuesday
With Sheets("Sheet1").Range("G27:K46")
.Copy
Sheets("Sheet2").Range("C106").PasteSpecial Paste:=xlValues
End With

'Copy Date Week .1 - Wednesday
With Sheets("Sheet1").Range("L7")
.Copy
Sheets("Sheet2").Range("A126:A145").PasteSpecial Paste:=xlValues
End With
'Copy Units
With Sheets("Sheet1").Range("A27:A46")
.Copy
Sheets("Sheet2").Range("B126").PasteSpecial Paste:=xlValues
End With
'Copy Data Week .1 - Wednesday
With Sheets("Sheet1").Range("L27:P46")
.Copy
Sheets("Sheet2").Range("C126").PasteSpecial Paste:=xlValues
End With

'Copy Date Week .1 - Thursday
With Sheets("Sheet1").Range("Q7")
.Copy
Sheets("Sheet2").Range("A146:A165").PasteSpecial Paste:=xlValues
End With
'Copy Units
With Sheets("Sheet1").Range("A27:A46")
.Copy
Sheets("Sheet2").Range("B146").PasteSpecial Paste:=xlValues
End With
'Copy Data Week .1 - Thursday
With Sheets("Sheet1").Range("Q27:P46")
.Copy
Sheets("Sheet2").Range("C146").PasteSpecial Paste:=xlValues
End With

'Copy Date Week .1 - Friday
With Sheets("Sheet1").Range("V7")
.Copy
Sheets("Sheet2").Range("A166:A185").PasteSpecial Paste:=xlValues
End With
'Copy Units
With Sheets("Sheet1").Range("A27:A46")
.Copy
Sheets("Sheet2").Range("B166").PasteSpecial Paste:=xlValues
End With
'Copy Data Week .1 - Friday
With Sheets("Sheet1").Range("V27:Z46")
.Copy
Sheets("Sheet2").Range("C166").PasteSpecial Paste:=xlValues
End With

'Copy Date Week .1 - Saturday
With Sheets("Sheet1").Range("AA7")
.Copy
Sheets("Sheet2").Range("A186:A205").PasteSpecial Paste:=xlValues
End With
'Copy Units
With Sheets("Sheet1").Range("A27:A46")
.Copy
Sheets("Sheet2").Range("B186").PasteSpecial Paste:=xlValues
End With
'Copy Data Week .1 - Saturday
With Sheets("Sheet1").Range("AA27:AE46")
.Copy
Sheets("Sheet2").Range("C186").PasteSpecial Paste:=xlValues
End With



  #6   Report Post  
Old August 11th 17, 01:13 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Aug 2012
Posts: 137
Default Assistance in transposing multiple sets of data

Hi Claus

Happy to email you.

Can you provide your email please.

Cheers
Mark.
  #7   Report Post  
Old August 11th 17, 01:15 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Apr 2011
Posts: 3,542
Default Assistance in transposing multiple sets of data

Hi Mark,

Am Fri, 11 Aug 2017 05:13:07 -0700 (PDT) schrieb Living the Dream:

Can you provide your email please.


claus_busch(at)t-online.de


Regards
Claus B.
--
Windows10
Office 2016
  #8   Report Post  
Old August 11th 17, 08:33 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Apr 2015
Posts: 780
Default Assistance in transposing multiple sets of data

Mark,
Just a note about using Copy; -you can assign one cell's value to another cell
(or range) directly without incurring the extra overhead associated with
Copy/PasteSpecial, and speed up your process by orders of magnitude...

Dim wsSrc As Worksheet, wsTgt As Worksheet

Set wsSrc = ActiveWorkbook.Sheets("Sheet1")
Set wsTgt = ActiveWorkbook.Sheets("Sheet2")

wsTgt.Range("A2:A15") = wsSrc.Range("B7")

This next line I don't understand because you are assigning a range to a single
cell without resizing it to match the number of cells in the source range...

wsTgt.Range("B2").Resize(rows?, cols?) = wsSrc.Range("A9:A22")

...where wsSrc has 14 cells and so wsTgt needs to be resized as follows:

wsTgt.Range("B2").Resize(14, 1) = wsSrc.Range("A9:A22")
or
wsTgt.Range("B2").Resize(1, 14) =
Application.Transpose(wsSrc.Range("A9:A22"))

...where the latter puts a vertical range into a horizontal range.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
  #9   Report Post  
Old August 29th 17, 02:14 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Aug 2012
Posts: 137
Default Assistance in transposing multiple sets of data

Hi Garry

My apologies for not responding earlier, I have been super busy.

One of the issues, which Claus ironed out for me was that each sets of data were/had some irregularities.

I emailed Claus directly and after a couple of email To's & Fro's it all went reasonably well to a point where I could correct any anomalies fairly timely.

Thank again though.

Cheers
Mark.

  #10   Report Post  
Old August 29th 17, 04:11 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Apr 2015
Posts: 780
Default Assistance in transposing multiple sets of data

Hi Garry

My apologies for not responding earlier, I have been super busy.

One of the issues, which Claus ironed out for me was that each sets of data
were/had some irregularities.

I emailed Claus directly and after a couple of email To's & Fro's it all went
reasonably well to a point where I could correct any anomalies fairly timely.

Thank again though.

Cheers
Mark.


No worries!
Glad you & Claus got it sorted...

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Transposing Multiple Rows into 2 Data columns Toufik Excel Discussion (Misc queries) 1 January 10th 12 03:01 PM
transposing data from 1 column into multiple rows Gina Excel Discussion (Misc queries) 2 April 5th 07 06:06 PM
Multiple Data Sets corona91719 Excel Discussion (Misc queries) 1 March 16th 06 04:38 PM
transposing data from multiple tabs mjwillyone[_15_] Excel Programming 1 September 21st 04 08:11 PM
transposing data from multiple tabs mjwillyone[_14_] Excel Programming 1 September 15th 04 02:33 PM


All times are GMT +1. The time now is 07:54 AM.

Powered by vBulletin® Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Copyright 2004-2017 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Copyright © 2017