VBA code for inserting multiple rows, copying and transposing data

[Barry NP]

Hi all,


I am hoping that the following is possible to be done with vba code. I have searched but am struggling to find code to cover all of this. I have broken this down into 3 separate stages below.


I have a set of data in an excel spreadsheet that runs from column A to Column K and 6000 rows. The columns will always be the same, but the rows can increase over time. A snapshot example of data below.

A	B	C	D	E	F	G	H	I	J	K
David	Jones	10.0	2018	2019	2020	2021	2022	2023	2024	2025
Steve	Davies	10.0	2018	2019	2020	2021	2022	2023	2024	2025
Barry	Roberts	10.0	2018	2019	2020	2021	2022	2023	2024	2025
Mark	Nesling	10.0	2018	2019	2020	2021	2022	2023	2024	2025
Dereck	Roberts	10.0	2019	2019	2020	2021	2022	2023	2024	2025
Ashely	Roberts	10.0	2018	2019	2020	2021	2022	2023	2024	2025
Reece	Roberts	10.0	2018	2019	2020	2021	2022	2023	2024	2025
Tony	Davies	10.0	2018	2019	2020	2021	2022	2023	2024	2025
Mary	Davies	10.0	2018	2019	2020	2021	2022	2023	2024	2025

<tbody>
</tbody>

What I am looking at achieving is this (probably with a separate macro for each part):


1) Firstly I need 7 rows inserted between each line so that for e.g. Row 1 will have David Jones, followed by 7 blank rows and on row 9 will be Steve Davies and so on to the last row of data (circa 6000 rows).



2) I then need the newly inserted 7 blank rows to be auto filled with the data of the row above for columns A to C only, so for e.g rows 2 to 8 will show David Jones 10.00 for columns A to C. Then row 9 will show Steve Davies 10.00 and I then need rows 9 to 16 to also show Steve Davies 10.00 and so on. I need this to be done for all data rows to the last row of data. Columns D to K do not need to be auto-filled with the years in the newly inserted blank rows.



3) The last part that I am hoping to achieve is to cut and transpose the years for each row in columns D to K and to paste down in column D.


This needs to be done to the last row of data.


So what I would expect to see is the e.g. below with no data in columns E to K and years in column D.

A	B	C	D	E	F	G	H	I	J	K
David	Jones	10.0	2018
David	Jones	10.0	2019
David	Jones	10.0	2020
David	Jones	10.0	2021
David	Jones	10.0	2022
David	Jones	10.0	2023
David	Jones	10.0	2024
David	Jones	10.0	2025
Steve	Davies	10.0	2018
Steve	Davies	10.0	2019
Steve	Davies	10.0	2020
Steve	Davies	10.0	2021
Steve	Davies	10.0	2022
Steve	Davies	10.0	2023
Steve	Davies	10.0	2024
Steve	Davies	10.0	2025

<tbody>
</tbody>

This is a work project, so any help on this would be very, very gratefully received. I am an intermediate user of VBA and this has so far stumped me.


Keeping my fingers crossed on this one, so if you can assist it would be a massive help to me.


If you need any further clarification, please let me know.


Many thanks,


Barry.

 

[Peter_SSs]

Try this in a copy of your workbook. It assumes a heading row with the posted data starting in row 2 and places the rearranged data in columns N:Q. This placement can be altered if required once we are sure it is doing what you want.

Sub Rearrange()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  
  a = Range("A2", Range("K" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To 8 * UBound(a), 1 To 4)
  For i = 1 To UBound(a)
    For j = 4 To 11
      k = k + 1
      b(k, 1) = a(i, 1): b(k, 2) = a(i, 2): b(k, 3) = a(i, 3): b(k, 4) = a(i, j)
    Next j
  Next i
  Range("N2").Resize(UBound(b), 4).Value = b
End Sub

 

[Barry NP]

Many thanks for this Peter. I will use this first thing Monday morning and will test it to see if it works as expected. I will let you know the outcome on this. Once again many thanks.

 

[Peter_SSs]

Cheers. Hope it does the job for you.

 

[Barry NP]

Hi Peter. Just to let you know the code worked like a charm. Cannot thank you enough for this as this will save work colleagues hours of otherwise manual work!
Much appreciated.
Barry.

 

[Peter_SSs]

Hi Peter. Just to let you know the code worked like a charm. Cannot thank you enough for this as this will save work colleagues hours of otherwise manual work!
Much appreciated.
Barry.

Great news! Thanks for the follow-up.

 

[Barry NP]

Great news! Thanks for the follow-up.

Hi Peter.
Following on from the code the code that you provided above which works great, is there a way of using additional code that will format the rows that have been transposed (i.e. the year numbers) so that if a year has red font, this will show as red font in the final output.

If this is possible that would be great.

Many thanks in advance.

Barry.

 

[Peter_SSs]

Do you mean this?
Add this line immediately before the End Sub line

Columns("Q").Font.Color = vbRed

 

[Barry NP]

In an ideal world that would be fine. However not all years will have red font. There will be a mixture of std font and red font in the source data and I need the red font to show in the transposed data. Ideally formatting the transposed data as per the source data. If this is not possible I will think of an alternative way. Many thanks, Barry.

 

[Peter_SSs]

In an ideal world that would be fine. However not all years will have red font. There will be a mixture of std font and red font in the source data and I need the red font to show in the transposed data. Ideally formatting the transposed data as per the source data. If this is not possible I will think of an alternative way. Many thanks, Barry.

Sorry, I think I misread your previous post. I will look at this again when I can.