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



## Yann74

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.


----------



## Peter_SSs

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

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

Yann74 said:


> paste values only


.. before you said 


Yann74 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


----------



## Yann74

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

You're welcome. Glad we could help. Thanks for the follow-up.


----------



## badboybebe

Hi Peter
I have the same question like Yann. But I cant not use your code. Please help me guide to use it.
Many thanks


----------



## Peter_SSs

badboybebe said:


> Hi Peter
> I have the same question like Yann. But I cant not use your code. Please help me guide to use it.
> Many thanks


Welcome to the MrExcel board!

One way to implement a macro..
1. With your workbook active press Alt+F11 to bring up the vba window.
2. In the Visual Basic window use the menu to Insert|Module
3. Copy and Paste the code into the main right hand pane that opens at step 2.
4. Close the Visual Basic window.
5. Press Alt+F8 to bring up the Macro dialog
6. Select the macro & click ‘Run’
7. Your workbook will need to be saved as a macro-enabled workbook (*.xlsm)


----------



## badboybebe

994400-SPK2110200001.xlsmBCDE22CtnsItemDescriptionSize2310111001001105Jefferson JfyBlk/ShlWht M10M10246111001001105Jefferson JfyBlk/ShlWht M11M11252111001001105Jefferson JfyBlk/ShlWht M12M12Sheet1

Thanks for you help. I have run and it error in debug message
Let's me specific my situation. In my mini-sheet, Ctns (B) is the column shows how many row need to be copied, other column are data. Please help me any way to copy then numbered each row. 
Many thanks


----------



## Peter_SSs

Hmm, seems like your question is not quite the same as Yann74's after all. 

Please post another mini-sheet showing your expected results for the sample data above so that I can see just *what *they are and *where *they should be.


----------



## Yann74

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.


----------



## badboybebe

Book1ABCDE2110111001001105Jefferson JfyBlk/ShlWht M10M1032111001001105Jefferson JfyBlk/ShlWht M10M1043111001001105Jefferson JfyBlk/ShlWht M10M1054111001001105Jefferson JfyBlk/ShlWht M10M1065111001001105Jefferson JfyBlk/ShlWht M10M1076111001001105Jefferson JfyBlk/ShlWht M10M1087111001001105Jefferson JfyBlk/ShlWht M10M1098111001001105Jefferson JfyBlk/ShlWht M10M10109111001001105Jefferson JfyBlk/ShlWht M10M101110111001001105Jefferson JfyBlk/ShlWht M10M101216111001001105Jefferson JfyBlk/ShlWht M11M11132111001001105Jefferson JfyBlk/ShlWht M11M11143111001001105Jefferson JfyBlk/ShlWht M11M11154111001001105Jefferson JfyBlk/ShlWht M11M11165111001001105Jefferson JfyBlk/ShlWht M11M11176111001001105Jefferson JfyBlk/ShlWht M11M11Sheet1

Really? I think its almost the same
Here is what i want my data become. Or at least seperate number in column B into row. Example 10 means 10 row, 6 means 6 row


----------



## Peter_SSs

Peter_SSs said:


> so that I can see just .... and *where *they should be.


I'm not sure that you have shown me that, or perhaps it was the location of the original data? Anyway, all I can go on is what you have shown so try this with a copy of your workbook. If the locations of original data and results are as you have shown then the results will over-write, or part over-write, the original data if the results require more than 20 rows.



		VBA Code:
__


Sub ExpandRows()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  
  a = Range("B23", Range("E" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To Rows.Count, 1 To 5)
  For i = 1 To UBound(a)
    For j = 1 To a(i, 1)
      k = k + 1
      b(k, 1) = j
      If j = 1 Then b(k, 2) = a(i, 1)
      b(k, 3) = a(i, 2): b(k, 4) = a(i, 3): b(k, 5) = a(i, 4)
    Next j
  Next i
  Range("A2").Resize(k, UBound(b, 2)).Value = b
End Sub


----------



## badboybebe

I cant copy mini sheet so i send picture. The macro worked. But it only work with the last row. 
Sorry for copy too little data for you. My data has column to W, and thousand of row. 
Can we copy into a new sheet instead of overwrite the data row below?


----------



## Peter_SSs

badboybebe said:


> The macro worked. But it only work with the last row.


You showed in post #9 that your data actually started in row 23 so I wrote the code for that, but it appears you tested it on data that started in row 2. 



badboybebe said:


> My data has column to W, and thousand of row.



Do you have thousands of rows *before *the code runs or are you just saying there will be thousands of rows *after *the code has run?


Do you have any formulas on the sheet or is everything just constant text or numerical values?


Can you confirm whether column A has nothing in it before the code runs like the top image in your latest post or already contains 'Ctn No' data as shown in the bottom image?


----------



## badboybebe

badboybebe said:


> I cant copy mini sheet so i send picture. The macro worked. But it only work with the last row.
> Sorry for copy too little data for you. My data has column to W, and thousand of row.
> Can we copy into a new sheet instead of overwrite the data row below?


Or for more simple
Ignore all the other data and column. Can we just make row like the picture below. Column B is determine how many row will be. Copy into same sheet, new sheet or even another column like image is okay
Please help me !


----------



## badboybebe

Peter_SSs said:


> You showed in post #9 that your data actually started in row 23 so I wrote the code for that, but it appears you tested it on data that started in row 2.
> 
> 
> 
> Do you have thousands of rows *before *the code runs or are you just saying there will be thousands of rows *after *the code has run?
> 
> 
> Do you have any formulas on the sheet or is everything just constant text or numerical values?
> 
> 
> Can you confirm whether column A has nothing in it before the code runs like the top image in your latest post or already contains 'Ctn No' data as shown in the bottom image?


Ah yes, its works on row 23. So if i want to delete upper row, i will change code into new start position. And with data has W column, i will change Range"E" into Range"W", can I ?

Please ignore upper post, i did not know you answered me.

Great great great thanks  !!!!


----------



## Peter_SSs

badboybebe said:


> And with data has W column, i will change Range"E" into Range"W", can I ?


That will not be enough by itself, other changes will also be needed.
If you still need help with this, please answer my 3 questions?


----------



## badboybebe

Peter_SSs said:


> That will not be enough by itself, other changes will also be needed.
> If you still need help with this, please answer my 3 questions?


Yes, I have just tested and it did not work 

1. The number of rows will change in each file. This time is has 1354 rows. 
2. There is no fomula. 
3. The column Ctn No is no use for me. I can delete it


----------



## Peter_SSs

See if this is any use. Test with a *copy *of your workbook.
I have assumed that your headings are on row 22 with data starting on row 23 as you showed earlier.



		VBA Code:
__


Sub ExpandRows_v2()
  Dim r As Long, Rws As Long
  
  Application.ScreenUpdating = False
  ActiveSheet.Copy After:=ActiveSheet
  With ActiveSheet
    .Rows("1:21").Delete
    For r = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      Rws = .Cells(r, 2).Value
      If Rws > 1 Then
        .Rows(r + 1).Resize(Rws - 1).Insert
        .Range("C" & r).Resize(, 21).Copy Destination:=.Range("C" & r).Resize(Rws)
      End If
    Next r
    With .Range("A2:A" & .Range("C" & Rows.Count).End(xlUp).Row)
      .FormulaR1C1 = "=IF(RC[1]="""",R[-1]C+1,1)"
      .Value = .Value
      .Cells(0).Value = "No"
    End With
  End With
  Application.ScreenUpdating = True
End Sub


----------



## badboybebe

Whaooooo
Love to see it works. Even with new file. What i need to do is copy from row 21 then paste into new file with same row 21
Really really THANKS much


----------



## Yann74

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.


----------



## Peter_SSs

You're welcome. Thanks for the follow-up.


----------



## Legacy 395409

Hi, I know this is old thread, but I would like to know if anyone can add VBA Progress Bar within this thread's codes? Im doing the same thing, I got the insert & copy rows part working, but wonder if anyone knows how to add a progress bar to this insert & copy code so it'll show user progress while doing the insert & copy tasks.


----------



## Peter_SSs

johnnieso said:


> Hi, I know this is old thread, but I would like to know if anyone can add VBA Progress Bar within this thread's codes? Im doing the same thing, I got the insert & copy rows part working, but wonder if anyone knows how to add a progress bar to this insert & copy code so it'll show user progress while doing the insert & copy tasks.



This appears to be a duplicate of: VBA userform progress bar variant problem

In future, please do not post the same question multiple times. Per Forum Rules (#12), posts of a duplicate nature will be locked or deleted.

Please continue in the linked thread only.


----------



## beny698

Hello! I know this thread is kinda old but I have been trying to figure this out to no avail.

I've been using this code that Peter_SSs provided earlier in this thread and it works great. However I'm trying to do two other things to make it work best for me. I would like to make it so that instead of copying the whole row, it only copies everything in the row after column A. In addition, in the new sheet where the data is being copied to, I would like to number each row starting with "1". Is there any way to do that?



		VBA Code:
__


Public Sub CopyData()
    ' This routing will copy rows based on the quantity to a new sheet.
    Dim rngSinglecell As Range
    Dim rngQuantityCells As Range
    Dim intCount As Integer

    ' Set this for the range where the Quantity column exists. This works only if there are no empty cells
    Set rngQuantityCells = Range("A3", Range("A3").End(xlDown))

    For Each rngSinglecell In rngQuantityCells
        ' Check if this cell actually contains a number
        If IsNumeric(rngSinglecell.Value) Then
            ' Check if the number is greater than 0
            If rngSinglecell.Value > 0 Then
                ' Copy this row as many times as .value
                For intCount = 1 To rngSinglecell.Value
                    ' Copy the row into the next emtpy row in Final
                    Range(rngSinglecell.Address).EntireRow.Copy Destination:=Sheets("Final").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    ' The above line finds the next empty row.

                Next
            End If
        End If
    Next
End Sub


----------



## beny698

beny698 said:


> Hello! I know this thread is kinda old but I have been trying to figure this out to no avail.
> 
> I've been using this code that Peter_SSs provided earlier in this thread and it works great. However I'm trying to do two other things to make it work best for me. I would like to make it so that instead of copying the whole row, it only copies everything in the row after column A. In addition, in the new sheet where the data is being copied to, I would like to number each row starting with "1". Is there any way to do that?
> 
> 
> 
> VBA Code:
> __
> 
> 
> Public Sub CopyData()
> ' This routing will copy rows based on the quantity to a new sheet.
> Dim rngSinglecell As Range
> Dim rngQuantityCells As Range
> Dim intCount As Integer
> 
> ' Set this for the range where the Quantity column exists. This works only if there are no empty cells
> Set rngQuantityCells = Range("A3", Range("A3").End(xlDown))
> 
> For Each rngSinglecell In rngQuantityCells
> ' Check if this cell actually contains a number
> If IsNumeric(rngSinglecell.Value) Then
> ' Check if the number is greater than 0
> If rngSinglecell.Value > 0 Then
> ' Copy this row as many times as .value
> For intCount = 1 To rngSinglecell.Value
> ' Copy the row into the next emtpy row in Final
> Range(rngSinglecell.Address).EntireRow.Copy Destination:=Sheets("Final").Range("A" & Rows.Count).End(xlUp).Offset(1)
> ' The above line finds the next empty row.
> 
> Next
> End If
> End If
> Next
> End Sub


I apologize, this was not actually code Peter_SSs wrote. I got my tabs messed up. However, I would still love help if someone is able to assist. Thank you!


----------



## SAW001

Hey all, 

I am struggling to get this code working. Is it possible for someone to help me? 
Column H shows the number of seats in the group and Column E and F show the starting seat number and the last seat number. I need a code that will split out the seats on individual rows, If possible.


----------

