Macro: If cell contains value, then insert rows, based on cell value in a column

[nick612hayden]

Hey All

I'm am trying to figure out a macro to run that:

If cell on Column B (let's say B5) equals "1" "2" or "3"

Then insert (below) the the number of rows that the cell in F5 equals

So, if "1" shows up in cell B5, and if F5 equals 3, then 3 blank rows would be added below row 5

Then, go to the next row with data (after the rows that just were inserted) and repeat until there is no more data in the Workbook.

So now, if "2" shows up in the next cell (now, B9) and if F9 equals 2, then 2 blank rows would be added below row 9.

If the number doesn't show up in the cell in Column B, go to the next row and perform the macro.

Any help would be awesome, thanks!!! :D

 

[JoeMo]

JoeMo, you rock!!

I just want to take it a step above, I have information in columns A-J, is there a way that the entire row's information can be copied onto the new rows we created using this macro?
So for example, if I have row 2 creating 3 more rows below it, all the same exact information is carried over?

Assuming everything else remains the same, you can try this which is untested.

Sub InsertRowsIf()
Dim lr As Long, R As Range
lr = Range("B" & Rows.Count).End(xlUp).Row
Set R = Range("B1", "B" & lr)
Application.ScreenUpdating = False
For i = R.Rows.Count - 1 To 1 Step -1
    If R.Cells(i, 1).Value Like "[1-3]" Then
        If IsNumeric(R.Cells(i, 1).Offset(0, 4).Value) Then
            If R.Cells(i, 1).Offset(0, 4).Value > 0 Then
                R.Cells(i, 1).Offset(1, 0).Resize(R.Cells(i, 1).Offset(0, 4).Value, 1).EntireRow.Insert
                R.Cells(i, 1).Offset(0, -1).Resize(R.Cells(i, 1).Offset(0, 4).Value + 1, 10).FillDown
            End If
        End If
    End If
Next i
End Sub

 

[granger744]

Welcome to the board!

Try this:

Sub InsertRowsIf()
Dim lr As Long, R As Range, i As Long
lr = Range("B" & Rows.Count).End(xlUp).Row
Set R = Range("B1", "B" & lr)
Application.ScreenUpdating = False
For i = R.Rows.Count To 1 Step -1
    If IsNumeric(R.Cells(i, 1).Value) And Not IsEmpty(R.Cells(i, 1)) Then
        R.Cells(i, 1).Offset(1, 0).Resize(R.Cells(i, 1).Value).EntireRow.Insert
    End If
Next i
Application.ScreenUpdating = True
End Sub

Hey Joe, I want to say thanks so much for this! It has worked perfectly for the first step of what I need. Similar to thefirstslice I need the row to be copied down where the blanks were inserted. Further, the system that we input files to (costing data) will only handle 5 digit numbers (99999 or less), so any rows with a cost of 100000 or greater need to be split into groups of 99999 plus one remainder. These new values would go into the spot where the original cost was. It's a bit strange to explain in text so I mocked up an excel file that I'm hoping you can take a look at.

I've added the sheet to google drive here (https://docs.google.com/spreadsheets/d/111A050XmcDkbj6lDYgqk8IoSqqCbTq3QZw5jFfuczPA/edit?usp=sharing) because it seemed like the most secure way and I couldn't see functionality for this on the board. Sheet 1 is pre-macro, sheet 2 is post-macro (the one quoted), and sheet 3 is what I hope to achieve with one consolidated macro if possible.

Any ideas you have would be sooooo well appreciated!!

 

[bisik]

Please Help me. I am begging you guys!

 

[bisik]

JoeMo, I see you are the best here. please help me. my question is posted above

Try this:

Sub InsertRowsIf()
Dim lr As Long, R As Range
lr = Range("B" & Rows.Count).End(xlUp).Row
Set R = Range("B1", "B" & lr)
Application.ScreenUpdating = False
For i = R.Rows.Count - 1 To 1 Step -1
    If R.Cells(i, 1).Value Like "[1-3]" Then
        If IsNumeric(R.Cells(i, 1).Offset(0, 4).Value) Then
            If R.Cells(i, 1).Offset(0, 4).Value > 0 Then
                R.Cells(i, 1).Offset(1, 0).Resize(R.Cells(i, 1).Offset(0, 4).Value, 1).EntireRow.Insert
            End If
        End If
    End If
Next i
End Sub

 

[bisik]

JoeMo, help me! (((((
I also post in new thread https://www.mrexcel.com/forum/excel...ations-how-copy-row-add-data-based-value.html

Assuming everything else remains the same, you can try this which is untested.

Sub InsertRowsIf()
Dim lr As Long, R As Range
lr = Range("B" & Rows.Count).End(xlUp).Row
Set R = Range("B1", "B" & lr)
Application.ScreenUpdating = False
For i = R.Rows.Count - 1 To 1 Step -1
    If R.Cells(i, 1).Value Like "[1-3]" Then
        If IsNumeric(R.Cells(i, 1).Offset(0, 4).Value) Then
            If R.Cells(i, 1).Offset(0, 4).Value > 0 Then
                R.Cells(i, 1).Offset(1, 0).Resize(R.Cells(i, 1).Offset(0, 4).Value, 1).EntireRow.Insert
                R.Cells(i, 1).Offset(0, -1).Resize(R.Cells(i, 1).Offset(0, 4).Value + 1, 10).FillDown
            End If
        End If
    End If
Next i
End Sub

 

[tamiam2]

Hello,

I'm also trying to add different numbers of rows based on their cell value, for example:

in column E I have the values [TABLE="width: 35"]
<tbody>[TR]
[TD]R[/TD]
[/TR]
[TR]
[TD]V[/TD]
[/TR]
[TR]
[TD]B[/TD]
[/TR]
[TR]
[TD]D[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]

If the value ='R' then I need to insert 8 rows, if the value is 'V' I need 5 rows, if it's D, 8 and if it's B only 1. Is there a macro for this type of logic?

Thank you!

 

[JoeMo]

Hello,

I'm also trying to add different numbers of rows based on their cell value, for example:

in column E I have the values [TABLE="width: 35"]
<tbody>[TR]
[TD]R[/TD]
[/TR]
[TR]
[TD]V[/TD]
[/TR]
[TR]
[TD]B[/TD]
[/TR]
[TR]
[TD]D[/TD]
[/TR]
</tbody>[/TABLE]

If the value ='R' then I need to insert 8 rows, if the value is 'V' I need 5 rows, if it's D, 8 and if it's B only 1. Is there a macro for this type of logic?

Thank you!

Welcome to the board!

You didn't provide any information on what if anything you want to happen after the rows are inserted. This assumes you simply want the inserted rows left empty. This is case sensitive and looks for the entire cell content to be one of "R","V","B","D" to trigger the insertion.

Sub InsertRowsIftamian2()
Dim lr As Long, R As Range
lr = Range("E" & Rows.Count).End(xlUp).Row
Set R = Range("E1", "E" & lr)
Application.ScreenUpdating = False
For i = R.Rows.Count - 1 To 1 Step -1
    Select Case R.Cells(i, 1).Value
        Case "D", "R": R.Cells(i, 1).Offset(1, 0).Resize(8).EntireRow.Insert
        Case "V": R.Cells(i, 1).Offset(1, 0).Resize(5).EntireRow.Insert
        Case "B":: R.Cells(i, 1).Offset(1, 0).EntireRow.Insert
    End Select
Next i
Application.ScreenUpdating = True
End Sub