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.

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

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.

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

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

Assistance in transposing multiple sets of data
 

Hi Claus

Happy to email you.

Can you provide your email please.

Cheers
Mark.

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

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

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.

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

Assistance in transposing multiple sets of data
 

Hi Garry,

Am Tue, 29 Aug 2017 11:11:52 -0400 schrieb GS:

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

that's the code to solve the problem:

Sub TransposeTable()
Dim i As Long, j As Long, k As Long
Dim cols As Integer, counter As Integer, RCnt As Integer, myOffset As Integer, DateOffset As Integer
Dim rng1 As Range, rng2 As Range, dest As Range

i = 9
cols = 5
With Sheets("Sheet1")
For k = 1 To 106 '53 weeks x 2 sets/group
myOffset = IIf(Application.IsOdd(counter), 18, 28)
RCnt = IIf(Application.IsOdd(counter), 20, 14)
DateOffset = IIf(Application.IsOdd(counter), 20, 2)
If counter 0 Then i = i + myOffset
If Application.Sum(.Cells(i, 2).Resize(RCnt, 30)) = 0 Then Exit
For
For j = 2 To 27 Step 5
If j = 27 Then counter = counter + 1
Set rng1 = .Cells(i, 1).Resize(RCnt, 1)
Set rng2 = .Cells(i, j).Resize(RCnt, cols)
If Application.Sum(rng2) = 0 Then GoTo Skip
Set dest = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp)(2)
dest.Resize(RCnt) = .Cells(i - DateOffset, j)
dest.Offset(, 1).Resize(RCnt).Value = rng1.Value
dest.Offset(, 2).Resize(RCnt, cols).Value = rng2.Value
Skip:
Next
Next
End With
End Sub


Regards
Claus B.
--
Windows10
Office 2016

Assistance in transposing multiple sets of data
 

Nice!

--
Garry

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