insert x rows using input box between data only when value in column B changes

[JMoves]

I am trying to using an input box to ask "how many rows to be entered?" then insert X number of blank rows between existing data only when the value changes in column B.

For example, user states 5 in the input box - then 5 rows would be inserted between Row 5 and 6, Rows 8 and 9, Rows, 11 and 12, etc.

I can insert one row using the code below, however would like the number to be variable. If I try to run it more than once it provides more than one row beyond the second execution.

Sub InsertRowAtChangeInValue()
Dim lRow As Long
For lRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row To 4 Step -1
If Cells(lRow, "B") <> Cells(lRow - 1, "B") Then Rows(lRow).EntireRow.Insert
Next lRow
End Sub

Any help would be greatly appreciated.

 

[My Aswer Is This]

How does the value in column B change?

You said only when value in column B changes.
Your quote:

between existing data only when the value changes in column B.

Are you saying if B4 is Alpha and B5 is Bravo you want the script to ask how many rows to insert.​

 

[My Aswer Is This]

Try this:

Sub InsertRowAtChangeInValue()
'Modified  1/2/2020  8:20:42 PM  EST
Dim lRow As Long
Dim ans As Long
For lRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row To 4 Step -1
    If Cells(lRow, "B") <> Cells(lRow - 1, "B") Then
        ans = InputBox("How many rows")
        Rows(lRow).Resize(ans).EntireRow.Insert
    End If
Next lRow
End Sub

 

[JMoves]

Thank you very much for your response. Yes to the question above, sorry for not providing the corresponding example. Subfactor is column B, I would like to insert x rows using user input between the data when the value changes from A.1. or A.2. to B to D.1. etc.

The tried the code above and the input box keeps popping up to ask how many rows and no rows are inserted.

Below is what the data looks like:

Item	SubFactor
(i)	A.1.
(iv)	A.1.
(iii)(iv)	A.1.
(i)(ii)	A.2.
(i)(ii)(iii)(iv)	A.2.
(i)(ii)(iii)(iv)	A.2.
(i)(ii)(iii)(iv)	B.
(i)(ii)(iii)(iv)	B.
(i)(ii)(iii)(iv)	B.
(i)(ii)(iii)(iv)	D.1.
(i)(ii)(iii)(iv)	D.1.

 

[My Aswer Is This]

Your script shows

If Cells(lRow, "B") <> Cells(lRow - 1, "B") Then Rows(lRow).EntireRow.Insert

So this means if the two values are not exact.​

 

[JMoves]

Yes I would like the row inserted between A.1. and A.2. and then again between A.2. and B. etc. The number of rows included each one of these is variable.

 

[JMoves]

By variable I mean there may be 2 A.1's and then 5 A.2.s and I would like to insert x rows between these values. through the document when B changes.

 

[JMoves]

Try this:

Sub InsertRowAtChangeInValue()
'Modified  1/2/2020  8:20:42 PM  EST
Dim lRow As Long
Dim ans As Long
For lRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row To 4 Step -1
    If Cells(lRow, "B") <> Cells(lRow - 1, "B") Then
        ans = InputBox("How many rows")
        Rows(lRow).Resize(ans).EntireRow.Insert
    End If
Next lRow
End Sub

Thank you[U] My Aswer Is This[/U] I was able to solve my issue working with the code you provided. Your help is greatly appreciated!

 

[My Aswer Is This]

Thank you[U] My Aswer Is This[/U] I was able to solve my issue working with the code you provided. Your help is greatly appreciated!

Well you said earlier:

The tried the code above and the input box keeps popping up to ask how many rows and no rows are inserted.

But now I guess something is working so not sure what you changed but glad something is working​

 

[JMoves]

"ans" number of rows were being inserted, it would ask at each change in value from the bottom which make sense because it is finding the last row. I was at the top of the document so I didn't notice at first. I moved the ans= InputBox("How many rows") above the ForIRow and it now asks once and inserts "ans" number of rows between each change in value for the whole document. Thank you for helping me learn!

Sub InsertRowAtChangeInValue()
'Modified 1/5/2020 2:35:PM EST
Dim lRow As Long
Dim ans As Long
ans = InputBox("How many rows")
For lRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row To 4 Step -1
If Cells(lRow, "B") <> Cells(lRow - 1, "B") Then
Rows(lRow).Resize(ans).EntireRow.Insert
End If
Next lRow
End Sub