Adding new rows for over 2000 row I have

dankar

Board Regular
Joined
Mar 23, 2016
Messages
113
Office Version
  1. 365
Platform
  1. Windows
Dear All,

I have a table with 26 Columns and 2045 Row, I need to add rows with the same exact data but depending on the number available in COL2
meaning:
If I have number 2 in COL2 then I need to add ONE row with the same exact data except having COL2 for the new added rows is BLANK
If I have number 3 in COL2 then I need to add TWO rows with the same exact data except having COL2 for the new added rows is BLANK
If I have number 1 in COL2 then NO rows to Add.
If COL2 = Blank , NO rows to Add.
If COL2 = 4 then 3 rows need to be added wit the same exact data except COL2 is black in the 3 added rows.
IF COL2 = 10 then 9 rows need to be added with the same exact data except COL2 will be blank for the new 9 rows

If there is anything in COL2 other than number nothing to add (I will do this manually as they are few).

someone told me to use Macro (but I don't know how to use Macros) if this is the solution can someone explain how.


Thank you so much for any help suggested.

[TABLE="class: outer_border, width: 510"]
<tbody>[TR]
[TD]COL1
[/TD]
[TD]COL2
[/TD]
[TD]COL3
[/TD]
[TD]COL4
[/TD]
[TD]COL5
[/TD]
[TD]COL6
[/TD]
[TD]COL7
[/TD]
[TD]COL8
[/TD]
[TD]COL9
[/TD]
[TD]COL10
[/TD]
[/TR]
[TR]
[TD]A
[/TD]
[TD]2
[/TD]
[TD]B
[/TD]
[TD]C
[/TD]
[TD]D
[/TD]
[TD]E
[/TD]
[TD]F
[/TD]
[TD]G
[/TD]
[TD]H
[/TD]
[TD]I
[/TD]
[/TR]
[TR]
[TD]X
[/TD]
[TD]3
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[/TR]
[TR]
[TD]Y
[/TD]
[TD]1
[/TD]
[TD]Y
[/TD]
[TD]Y
[/TD]
[TD]Y
[/TD]
[TD]Y
[/TD]
[TD]Y
[/TD]
[TD]Y
[/TD]
[TD]Y
[/TD]
[TD]Y
[/TD]
[/TR]
[TR]
[TD]F
[/TD]
[TD]4
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[/TR]
[TR]
[TD]D
[/TD]
[TD]7(1ml)
[/TD]
[TD]D
[/TD]
[TD]D
[/TD]
[TD]D
[/TD]
[TD]D
[/TD]
[TD]D
[/TD]
[TD]D
[/TD]
[TD]D
[/TD]
[TD]D
[/TD]
[/TR]
[TR]
[TD]B
[/TD]
[TD][/TD]
[TD]B
[/TD]
[TD]B
[/TD]
[TD]B
[/TD]
[TD]B
[/TD]
[TD]B
[/TD]
[TD]B
[/TD]
[TD]B
[/TD]
[TD]B
[/TD]
[/TR]
</tbody>[/TABLE]

RESULT:[TABLE="class: outer_border, width: 500"]
<tbody>[TR]
[TD]COL1
[/TD]
[TD]COL2
[/TD]
[TD]COL3
[/TD]
[TD]COL4
[/TD]
[TD]COL5
[/TD]
[TD]COL6
[/TD]
[TD]COL7
[/TD]
[TD]COL8
[/TD]
[TD]COL9
[/TD]
[TD]COL10
[/TD]
[/TR]
[TR]
[TD]A
[/TD]
[TD]2
[/TD]
[TD]B
[/TD]
[TD]C
[/TD]
[TD]D
[/TD]
[TD]E
[/TD]
[TD]F
[/TD]
[TD]G
[/TD]
[TD]H
[/TD]
[TD]I
[/TD]
[/TR]
[TR]
[TD]A
[/TD]
[TD][/TD]
[TD]B
[/TD]
[TD]C
[/TD]
[TD]D
[/TD]
[TD]E
[/TD]
[TD]F
[/TD]
[TD]G
[/TD]
[TD]H
[/TD]
[TD]I
[/TD]
[/TR]
[TR]
[TD]X
[/TD]
[TD]3
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[/TR]
[TR]
[TD]X
[/TD]
[TD][/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[/TR]
[TR]
[TD]X
[/TD]
[TD][/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[TD]X
[/TD]
[/TR]
[TR]
[TD]Y
[/TD]
[TD]1
[/TD]
[TD]Y
[/TD]
[TD]Y
[/TD]
[TD]Y
[/TD]
[TD]Y
[/TD]
[TD]Y
[/TD]
[TD]Y
[/TD]
[TD]Y
[/TD]
[TD]Y
[/TD]
[/TR]
[TR]
[TD]F
[/TD]
[TD]4
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[/TR]
[TR]
[TD]F
[/TD]
[TD][/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[/TR]
[TR]
[TD]F
[/TD]
[TD][/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[/TR]
[TR]
[TD]F
[/TD]
[TD][/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[TD]F
[/TD]
[/TR]
[TR]
[TD]D
[/TD]
[TD]7(1ml)
[/TD]
[TD]D
[/TD]
[TD]D
[/TD]
[TD]D
[/TD]
[TD]D
[/TD]
[TD]D
[/TD]
[TD]D
[/TD]
[TD]D
[/TD]
[TD]D
[/TD]
[/TR]
[TR]
[TD]B
[/TD]
[TD][/TD]
[TD]B
[/TD]
[TD]B
[/TD]
[TD]B
[/TD]
[TD]B
[/TD]
[TD]B
[/TD]
[TD]B
[/TD]
[TD]B
[/TD]
[TD]B
[/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
How about this
Code:
Sub Addrows()

    Dim Rw As Long
    Dim Num As Variant
    
    For Rw = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
        Num = Range("B" & Rw).Value
        If IsNumeric(Num) And Num > 1 Then
            Rows(Rw + 1).Resize(Num - 1).Insert
            Rows(Rw).Resize(Num).FillDown
            Range("B" & Rw + 1).Resize(Num - 1).Clear
        End If
    Next Rw

End Sub
 
Upvote 0
How about this
Code:
Sub Addrows()

    Dim Rw As Long
    Dim Num As Variant
    
    For Rw = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
        Num = Range("B" & Rw).Value
        If IsNumeric(Num) And Num > 1 Then
            Rows(Rw + 1).Resize(Num - 1).Insert
            Rows(Rw).Resize(Num).FillDown
            Range("B" & Rw + 1).Resize(Num - 1).Clear
        End If
    Next Rw

End Sub

Thanks for your fast reply, I believe this is a Macro, right? would you please explain to me what to do so I can try your solution,

where to paste the code so I can try it..

Thank you
 
Upvote 0
And also please what does "A" and "B" refers to ? am sorry but am totally new to codes
 
Upvote 0
They refer to the columns, ie columns A & B.
So
Code:
Range("A" & Rows.Count).End(xlUp).Row
Is looking for the last used cell in Col A, whilst
Code:
 Num = Range("B" & Rw).Value
Is setting the Num = to the value of a cell in col B.
so in your example if Rw is 5 then num = the value of cell B5 ie 4

Excel 2013 32 bit
ABCDEFGHIJ
1COL1COL2COL3COL4COL5COL6COL7COL8COL9COL10
2A2BCDEFGHI
3X3XXXXXXXX
4Y1YYYYYYYY
5F4FFFFFFFF
6D7(1ml)DDDDDDDD
7BBBBBBBBB
BILLED
 
Upvote 0
Thank you sooooo much...this is Remarkable! I didn't expect this to be solved with such a small code and this easy way.

May I ask you few things regarding this code:

*** In my table the value column is D ****

1. Range("B" & Rw + 1).Resize(Num - 1).Clear , I believe this line is for clearing the Cell of the new rows , Can you explain this for me ?


2. As you explained : " Range("A" & Rows.Count).End(xlUp).Row Is looking for the last used cell in Col A "

In my table the last 15 row, Column A and B is blank so when applying you code it didn't reach to this area.,I solved it by add new column with sequence number starting from 1 to 2045 and I applied your code again and it worked perfectly.

Is it possible to adjust the code so it can work in a range of cells (for example from Cell A1 : A2045)

3. Is it possible to highlight the new added rows with any color so I can separate the new rows from the original ones ?

Again thank you so much for your fast reply and help..you are Awesome!
 
Upvote 0
By this
*** In my table the value column is D ****
Do you mean that Col2 in the sample you provided, is in Col D?
 
Upvote 0
Yes.

something like this:

The actual column in my table (the one that have the numbers is in Column D) and when I added the new column with the sequence numbers(to prevent the last used cell) it became E

A
B
C
D
E
F
G
H
I
J
COL1
COL2
COL3
COL4
COL5
COL6
COL7
COL8
COL9
COL10
A
B
2
D
E
F
G
H
I
X
X
3
X
X
X
X
X
X
Y
Y
1
Y
Y
Y
Y
Y
Y
F
4
F
F
F
F
F
F
D
7(1ml)
D
D
D
D
D
D
B
B
B
B
B
B
B

<tbody>
[TD="align: center"]1
[/TD]

[TD="align: center"]2
[/TD]

[TD="align: right"]A
[/TD]

[TD="align: center"]3
[/TD]

[TD="align: right"]X
[/TD]

[TD="align: center"]4
[/TD]

[TD="align: right"]Y
[/TD]

[TD="align: center"]5
[/TD]

[TD="align: right"][/TD]

[TD="align: center"]6
[/TD]

[TD="align: center"]7
[/TD]

[TD="align: right"][/TD]

</tbody>
 
Last edited:
Upvote 0
If Your col2 is Column D, try this
Code:
Sub Addrows()

    Dim Rw As Long
    Dim Num As Variant
    Dim Usdrws As Long
    
'    This finds the last used row of data
    Usdrws = Cells.Find("*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    For Rw = Usdrws To 2 Step -1
        Num = Range("D" & Rw).Value                                     'stores the value of Col D
        If IsNumeric(Num) And Num > 1 Then
            Rows(Rw + 1).Resize(Num - 1).Insert                         'inserts the new rows
            Rows(Rw).Resize(Num).FillDown                               'copies the data into the new rows
            Rows(Rw + 1).Resize(Num - 1).Interior.Color = vbYellow      'highlights the new rows in yello
            Range("D" & Rw + 1).Resize(Num - 1).ClearContents           'Removes the values in Col D for the added rows
        End If
    Next Rw

End Sub
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,325
Members
452,635
Latest member
laura12345

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
Back
Top