Insert rows - fastest approaches

[JackDanIce]

Hi,

Writing a macro that lifts specific columns from a source sheet into a destination sheet. Unable to find decent answer online, though may not be asking in way that returns meaningful results.

One column is date at start of week (Monday) followed by daily hours in adjacent columns

I'd like to transpose daily hours into rows as fast as possible.

Unable to download software to show screen, so best text attempt:

Source Sheet (~7,000 rows like below from opened workbook)
Name Date Total Hours Mon Tue Wed Thur Fri Sat Sun
Jack Daniels 16/04/2018 40 7.5 7.5 7.5 7.5 7.5 0 2.5

Destination Sheet: (macro runs in this workbook and opens source sheet first; the destination sheet should finish with 7x row count from source sheet)
Name Date Hours
Jack Daniels 16/04/2018 7.5
Jack Daniels 17/04/2018 7.5
Jack Daniels 18/04/2018 7.5
Jack Daniels 19/04/2018 7.5
Jack Daniels 20/04/2018 7.5
Jack Daniels 21/04/2018 0
Jack Daniels 22/04/2018 2.5

(Destination sheet doesn't need total hours)

Any suggestions on shortest time for transform process?

Unsure if:
#1 Copy all data first, then use For Loop with Step 6 to insert required rows or
#2 Iterate through source data (normal For Loop) and copy each row to destination but add 6 to destination row after each copy operation

Thank you in advance,
Jack

 

[JackDanIce]

Just remembered, #3 Previously, I've used UNION to create a range of cells and then inserted rows in a single operation, so in this case copy data like #1 , loop over it to build a union range and then insert cells

I think this is fastest with least number of row insert operations but keen to hear other suggestions and explanations.

 

[Fluff]

How about something like

Sub Copytranspose()
   Dim Sws As Worksheet
   Dim Dws As Worksheet
   Dim Cl As Range
   Set Sws = Sheets("Source")
   Set Dws = Sheets("destination")
   For Each Cl In Sws.Range("A2", Sws.Range("A" & Rows.Count).End(xlUp))
      With Dws.Range("A" & Rows.Count).End(xlUp).Offset(1)
         .Resize(7, 2).Value = Cl.Resize(, 2).Value
         .Offset(, 2).Resize(7).Value = Application.Transpose(Cl.Offset(, 3).Resize(, 7))
      End With
   Next Cl
End Sub

 

[JackDanIce]

Hey @Fluff, just realised I'm going to have to iterate over the data to transpose so could combine with reading it in. Will try and reply, thank you for suggesting

 

[JackDanIce]

Hi Fluff, sorry late reply, adapted some of the suggest code, works great, thank you

 

[Fluff]

Glad to help & thanks for the feedback

 

[Peter_SSs]

I subscribed to this thread last week but have not been able to get back to it until now. However, given the following request, I do have a suggestion.

Any suggestions on shortest time for transform process?

For me, the code below is about 4 times faster. For 7,000 rows only, that will not make a great apparent difference, but you did ask.

I have assumed that:
- the source sheet contains the data in columns A:J with headings in row 1
- the destination sheet already exists but contains no data.

Sub Copytranspose_v2()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  
  With Sheets("Source")
    a = .Range("A2", .Range("J" & .Rows.Count).End(xlUp)).Value
  End With
  ReDim b(1 To UBound(a) * 7, 1 To 3)
  For i = 1 To UBound(a)
    For j = 4 To 10
      k = k + 1
      b(k, 1) = a(i, 1): b(k, 2) = a(i, 2): b(k, 3) = a(i, j)
    Next j
  Next i
  With Sheets("Destination").Columns("A:C")
    .Rows(1).Value = Array("Name", "Date", "Hours")
    .Rows(2).Resize(UBound(b)).Value = b
    .AutoFit
  End With
End Sub

 

[JackDanIce]

Hey Peter, been a while, thanks for replying and can see how this is faster but unfortunately the destination sheet contains data, specifically

Headers: X1 X2 X3 Mon Tue Wed Thur Fri Sat Sun

Mon - Sun need to be transposed to independent rows with data from above X1 X2 X3 etc either duplicated or incremented. Having said that, I'm reading data from a source file into an array.. as I write this reply, I can see how to change the code to create a larger array; create a separate function and output the new array to blank destination sheet.

Great, gives me an improvement to think about, thank you too!

 

[Peter_SSs]

I'm not really sure what you are saying. I created a test 'Source' sheets laid out like post #1 but with 7000 rows of varied data and a blank 'Destination' sheet. I ran Fluff's code, renamed that destination sheet & created a new blank one and ran my code. Comparing the two destination sheets, mine & Fluff's were identical (apart from the heading row in mine v blank row 1 for Fluff's)

 

[JackDanIce]

Probably not explaining myself clearly enough and using short descriptions to address the problem than the bigger picture.

It's cool, you've given me something to consider in conjunction with Fluff's original which I've adjusted to work with set up here, all good thank you!