Insert row on base on cell value

[chua_sb]

Hi Eveyone and Expert.
I need help.. I want to insert row base on the cell value. Can anyone help me out here?

Sub BlankLine()
'Updateby20150203
Dim Rng As Range
Dim WorkRng As Range
Dim xInsertNum As Long

' On Error Resume Next
xTitleId = "Kutools for Excel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
If WorkRng Is Nothing Then Exit Sub
xInsertNum = Application.InputBox("The number of blank rows you want to insert", xTitleId, Type:=1)
If xInsertNum = False Then
MsgBox " The number of blank rows you want to insert ", vbInformation, xTitleId
Exit Sub
End If
Set WorkRng = WorkRng.Columns(1)
xLastRow = WorkRng.Rows.Count
Application.ScreenUpdating = False
For xRowIndex = xLastRow To 1 Step -1
Set Rng = WorkRng.Range("A" & xRowIndex)


If InStr(Rng.Value, "ALLEN") = 0 And InStr(Rng.Value, "ATC") = 0 And IsNumeric(Rng.Value) And Rng.Value > 0 Then
Rng.Offset(1, 0).Resize(xInsertNum).EntireRow.Insert Shift:=xlDown


End If
Next
Application.ScreenUpdating = True
End Sub

 

[chua_sb]

I typically do not like to try to amend/change code that I didn't write, especially if it is not working in the first place!
If it was working except for one minor piece, or it was working and you wanted to add a little something extra, that would be one thing.
But I don't want to start working with code that is not working and may be far down the wrong path. I prefer to write my own code from scratch, rather than try to deal with that.

Regarding the column to run this against, do you want a prompt to ask for the column letter, or do you just want it to run on the column of the active cell that is selected when you call the macro?

Also, rather than me trying to recreate that table from scratch, can you post it in a manner which allows me to copy it?
MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

Thank you so much.. The code is working.. I only can choose the number of line to be insert which this will apply to all "number" cells. Ie:
I want it to run on the column of the active cells when selected..

 

[chua_sb]

REQUESTED P/N	DESCRIPTION	QTY	AAR QTE PN	QTY QTE	PRICE (EA)	EXT'D SALES	COND	LEADTIME (Days)	TRACE	CERTIFICATE	SN	ALTERNATE PN	ALLEN ATC
G4000VSVA01	-	1	G4000VSVA01	1	-	-	CHECK	-	-	-	-	-	6
1708897	-	1	1708897	1	-	-	CHECK	-	-	-	-	-	1
01N65920	ELT (1)	1	01N65920	1	-	-	OHC	STOCK @BRUSSEL		AVIA 10/2022	17353331	-	1 - in ALLEN
3880938-1	FILTER ELEMENT	1	3880938-1	1	$1,829.79	$1,829.79	FN	STOCK	OEM	OEM	-	-	-
60-755100-5	MOTOR IMPELLER SUBASSY, FUEL BOOST PUMP	1	60-755100-5	1	-	-	SVCS	STOCK @BRUSSEL	CFM INTERNATIONAL INC.	NOVO 1/2023	030634004	-	1 - in ALLEN
CH31900-6	-	1	518888-1	1	$1,252.43	$1,252.43	FN	STOCK	OEM	OEM	-	518888-1	-
99-000125-794-0	BOUCHON DE SECURITE	1	99-000125-794-0	MOQ:10	$52.87	$528.74	FN	218	OEM	OEM	-	-	-
9072215-1	IGNITER PLUG (IRID)	1	9072215-1	1	$1,283.48	$1,283.48	FN	STOCK	OEM	OEM	-	518888-1	-
8061-865	M.E.C (11)	1	8061-865	1	-	-	CHECK	-	-	-	-	-	2 - in ATC
1B6503-01	LPC DISK (11)	1	1B6503-01	1	-	-	CHECK	-	-	-	-	-	1 - in ATC
54L064	AIRSEAL (11)	1	54L064	1	-	-	CHECK	-	-	-	-	-	2 - in ATC
3522W000-001	-	1	3522W000-001	1	-	-	-	-	-	-	-	-	-
52B121-01	DISK Y (11)	1	52B121-01	1	-	-	CHECK	-	-	-	-	-	1 - in ATC
C13200HA02	FMGEC (1)	1	C13200HA02	1	-	-	CHECK	-	-	-	-	-	2 - in ALLEN
822-1710-312	RECEIVER (1)	1	822-1710-312	1	-	-	SVCS	STOCK @BRUSSEL		ROCKWELL 2/2020	45C9GT	-	1 - in ALLEN
C12850BC03	-	1	C12850BC03	1	-	-	CHECK	-	-	-	-	-	3
20790-03AC	-	1	20790-03AC	1	-	-	CHECK	-	-	-	-	-	3
801A50-0005-A	-	1	801A50-0005A	1	$28.82	$28.82	FN	STOCK	OEM	OEM	-	801A50-0005A	-
C12848EA01	-	1	C12848EA01	1	-	-	-	-	-	-	-	-	-
790425A6	STARTER (1)	1	790425A9	1	$85,000.00	$85,000.00	FN	1100	OEM	OEM	-	790425A9	-
9057067	SEAL	1	9057067	1	$2,046.44	$2,046.44	FN	STOCK	OEM	OEM	-	-	-
34000055-7	-	1	34000055-7	1	$27,425.82	$27,425.82	FN	406	OEM	OEM	-	-	-
TY2091-01A	PRIMARY (1)	1	TY2091-01A	1	-	-	CHECK	-	-	-	-	-	2 - in ALLEN
7588429	-	1	7588429	1	$31.00	$31.00	FN	STOCK	OEM	OEM	-	-	-
1027-2-011-8006	-	1	1027-2-011-8006	1	-	-	-	-	-	-	-	-	-
4291011	MOTOR	1	4291011	1	$2,450.00	$2,450.00	SVCS	STOCK @BRUSSEL		FIRST 11/2017	100062	-	1 - in ALLEN

 

[chua_sb]

Do you think the above is good enough? I'm not sure if the above can be upload to the link as i'm using computer laptop.

 

[Joe4]

I think the code can be simplified a bit. This should do what you want (there really aren't all that many lines there when you take out all my comments):

Sub MyInsertLines()

    Dim c As Long
    Dim lr As Long
    Dim r As Long
    Dim n As Long
   
    Application.ScreenUpdating = False
   
'   Get column of active cell
    c = ActiveCell.Column
   
'   First last row in column with data
    lr = Cells(Rows.Count, "C").End(xlUp).Row
   
'   Loop through all rows backwards
    For r = lr To 2 Step -1
'       See if entry in column is numeric
        If IsNumeric(Cells(r, c)) Then
'           Get number of rows to insert
            n = Cells(r, c)
'           Insert rows
            Cells(r + 1, c).Resize(n).EntireRow.Insert Shift:=xlDown
        End If
    Next r
   
    Application.ScreenUpdating = True

End Sub

 

[chua_sb]

I think the code can be simplified a bit. This should do what you want (there really aren't all that many lines there when you take out all my comments):

Sub MyInsertLines()

    Dim c As Long
    Dim lr As Long
    Dim r As Long
    Dim n As Long
  
    Application.ScreenUpdating = False
  
'   Get column of active cell
    c = ActiveCell.Column
  
'   First last row in column with data
    lr = Cells(Rows.Count, "C").End(xlUp).Row
  
'   Loop through all rows backwards
    For r = lr To 2 Step -1
'       See if entry in column is numeric
        If IsNumeric(Cells(r, c)) Then
'           Get number of rows to insert
            n = Cells(r, c)
'           Insert rows
            Cells(r + 1, c).Resize(n).EntireRow.Insert Shift:=xlDown
        End If
    Next r
  
    Application.ScreenUpdating = True

End Sub

WOW WOW WOW.. It work Joe!
OMG!!!!!! You just done it in like 5 mins? Seriously? I spend hours trying to figure out..

Is it normal to have the below error message? I mean the code is working but just seeing this error.

 

[Joe4]

WOW WOW WOW.. It work Joe!
OMG!!!!!! You just done it in like 5 mins? Seriously? I spend hours trying to figure out..

Is it normal to have the below error message? I mean the code is working but just seeing this error.



View attachment 88744

If you hit the "Debug" button, which line of code does it highlight?

What is your first actual row with data? If it is not row 2, then change the value here to match your first data row number:

    For r = lr To 2 Step -1

Also, things like any errors in the column we are looping through, or merged or protected cells in the data could cause issues as well.

 

[chua_sb]

If you hit the "Debug" button, which line of code does it highlight?

What is your first actual row with data? If it is not row 2, then change the value here to match your first data row number:

    For r = lr To 2 Step -1

It's done Joe! OMG.. I can't thank you enough!

You my saviour!!!!!!!!!!!!!

A thousand Thank you Joe..

 

[Joe4]

You are welcome.
Glad I was able to help.

 

[chua_sb]

You are welcome.
Glad I was able to help.

That's a crazy big help to a stranger! I can't thank you enough.. Have a nice day Sir.

 

[Joe4]

That's a crazy big help to a stranger! I can't thank you enough.. Have a nice day Sir.

You too!

Note that I updated the post marked as the solution. You typically want to mark the post that contains the solution.
That way if someone were to view the thread, they would see the original question, and then the solution right beneath it.