VBA code for inserting multiple rows, copying and transposing data

Barry NP

New Member
Joined
Jul 18, 2017
Messages
20
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.


ABCDEFGHIJK
DavidJones10.020182019202020212022202320242025
SteveDavies10.020182019202020212022202320242025
BarryRoberts10.020182019202020212022202320242025
MarkNesling10.020182019202020212022202320242025
DereckRoberts10.020192019202020212022202320242025
AshelyRoberts10.020182019202020212022202320242025
ReeceRoberts10.020182019202020212022202320242025
TonyDavies10.020182019202020212022202320242025
MaryDavies10.020182019202020212022202320242025

<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.



ABCDEFGHIJK
DavidJones10.02018
DavidJones10.02019
DavidJones10.02020
DavidJones10.02021
DavidJones10.02022
DavidJones10.02023
DavidJones10.02024
DavidJones10.02025
SteveDavies10.02018
SteveDavies10.02019
SteveDavies10.02020
SteveDavies10.02021
SteveDavies10.02022
SteveDavies10.02023
SteveDavies10.02024
SteveDavies10.02025

<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

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
41,782
Office Version
365
Platform
Windows
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.

Code:
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
 
Last edited:

Barry NP

New Member
Joined
Jul 18, 2017
Messages
20
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

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
41,782
Office Version
365
Platform
Windows
Cheers. Hope it does the job for you. :)
 

Barry NP

New Member
Joined
Jul 18, 2017
Messages
20
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

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
41,782
Office Version
365
Platform
Windows
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

New Member
Joined
Jul 18, 2017
Messages
20
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

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
41,782
Office Version
365
Platform
Windows
Do you mean this?
Add this line immediately before the End Sub line
Code:
Columns("Q").Font.Color = vbRed
 

Barry NP

New Member
Joined
Jul 18, 2017
Messages
20
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

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
41,782
Office Version
365
Platform
Windows
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.
 

Forum statistics

Threads
1,078,145
Messages
5,338,507
Members
399,238
Latest member
amuthan10

Some videos you may like

This Week's Hot Topics

Top