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.

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

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.

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

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

Hi Claus

Happy to email you.

Can you provide your email please.

Cheers
Mark.

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

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

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.

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

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

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