Inserting new rows based on cell value, and copying data to the new rows

Yann74

New Member
Joined
Jul 26, 2021
Messages
3
Office Version
  1. 2016
Platform
  1. Windows
Hi all,

I've been searching a solution to my issue on the board but could not find a working solution that covers my needs.
I'd really appreciate some help to come up with a VBA code that does the following:

I have an Excel file with multiple sheets. In a specific sheet called "xyz" I have data from columns A to BW. Row 1 is for data labels.
The number of rows is variable depending on the source data.

I'd need code to check if column C contains a number or if it's empty.
If it's empty, then proceed to next row.
If it contains a number, then the code should insert the corresponding number of rows below, while copying (and keeping the format) columns G to BW from the origin row to the newly inserted ones.
The loop should process all rows iteratively until there is no data in column A.

For example:
Cell C2 contains "2". Code should insert 2 new rows under row 2 (so 3 and 4) and should copy G2:BW2 to G3:BW3 and G4:BW4 .

Cell C3 (now C5 after the previous rows have been inserted) contains "3". Code should insert 3 new rows under row 5 (so 6, 7 and 8) and should copy G5:BW5 to G6:BW6, G7:BW7 and G8:BW8.

Cell C9 and the the entire row 9 have no data, so the loop should stop.

Many thanks in advance for your kind help!
Yann.
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
51,165
Office Version
  1. 365
Platform
  1. Windows
Welcome to the MrExcel board!

Give this a try with a copy of your workbook.

VBA Code:
Sub Inert_rows()
  Dim r As Long
  
  For r = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    With Cells(r, 3)
      If IsNumeric(.Value) And Not IsEmpty(.Value) Then
        Rows(r + 1).Resize(.Value).Insert
        Range(Replace("G#:BW#", "#", r)).Copy Destination:=Range("G" & r + 1).Resize(.Value)
      End If
    End With
  Next r
End Sub
 

Yann74

New Member
Joined
Jul 26, 2021
Messages
3
Office Version
  1. 2016
Platform
  1. Windows
Hi Peter,

Many thanks for your quick answer!
Your code works great, to one exception, and it's probably my fault for not being specific enough.
Some of my values between columns G and BW are formulas, so when doing "resize" (which is like manually dragging cells down I believe), it drags the formulas, which generates incorrect data in the new rows.
How would you go about replacing "Resize" by copy and paste values only?

Thanks again,
Yann.
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
51,165
Office Version
  1. 365
Platform
  1. Windows
paste values only
.. before you said
and keeping the format
.. so I have included values and formats in the paste below.

VBA Code:
Sub Inert_rows_v2()
  Dim r As Long
  
  Application.ScreenUpdating = False
  For r = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    With Cells(r, 3)
      If IsNumeric(.Value) And Not IsEmpty(.Value) Then
        Rows(r + 1).Resize(.Value).Insert
        Range(Replace("G#:BW#", "#", r)).Copy
        Range("G" & r + 1).Resize(.Value).PasteSpecial Paste:=xlPasteValues
        Range("G" & r + 1).Resize(.Value).PasteSpecial Paste:=xlPasteFormats
      End If
    End With
  Next r
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub
 
Solution

Yann74

New Member
Joined
Jul 26, 2021
Messages
3
Office Version
  1. 2016
Platform
  1. Windows
Hi Peter,

Sorry for making it more complicated for you. 😅

I've tested the new code and it works flawlessly!

Big huge thanks to you for your time and expertise!
I have occasionally used these forums to find code that would help with my excel projects, but it's the first time I ask for help directly, and you've been more than helpful. Thank you.

Kind Regards,
Yann.
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
51,165
Office Version
  1. 365
Platform
  1. Windows
You're welcome. Glad we could help. Thanks for the follow-up. :)
 

Forum statistics

Threads
1,144,370
Messages
5,723,959
Members
422,529
Latest member
mbilal429

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top