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.

 

[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

 

[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]

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?

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]

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?

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.

 

[OutLine86]

Hi @Peter_SSs ,

I do have exactly the same application as Yann74 but I don't find the way to make the macro work... I followed all your steps and use the same cells as Yann74 but there should be something wrong as nothing happens when I execute the macro. Would you mind having a look at what should be wrong or send me a working file with your code. You can see my file at the link below:

Test file

Thank you!

 

[Peter_SSs]

I do have exactly the same application as Yann74

Welcome to the MrExcel board!

From what you have shown, you don't actually have exactly the same as Yann74 & that is why the code is not doing anything for you.
In post #1 it says

The loop should process all rows iteratively until there is no data in column A.

Since you have no data in column A (at least in the sample shown) the code will evaluate this line
For r = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
to
For r = 1 to 1 Step -1
and in that single loop the value in column C (3) is not Numeric as evaluated in the following code, so nothing happens

With Cells(r, 3)
  If IsNumeric(.Value) And Not IsEmpty(.Value) Then

So, it looks like your processing should start on row 2 and would it be safe to use column C to determine where to stop instead of column A?
Or is your real layout different again from your sample?

 

[khoowy]

Hi @Peter_SSs, thank you for providing the solution. Could you please advise how to minus 1 row based on the cell value? For example, the cell value is 5, I would like to add another 4 rows after the first row, total up 5 rows. Thank you.