dubmartian
New Member
- Joined
- Dec 16, 2016
- Messages
- 20
I would like to edit this script to add text to inserted rows.
Every insert row will be 2 and I would like to add text to the two cells.
example:
apple
pear
bananna
(scripts inserts 2 rows after every occasion of bananna)
inserted row 1 ( text string included = "help")
inserted row 2 (text string included = "me")
peach
strawberry
end example
Can this be done?
The code Im using ->
Option Explicit
Sub Insert_Rows()
Dim i As Long, lRows As Long, lastrow As Long, lngCount As Long
Dim strTxt As String
Application.ScreenUpdating = False
lastrow = Cells(Rows.Count, "C").End(xlUp).Row
lRows = Application.InputBox("How many rows do you want to insert?", Type:=1)
If lRows < 1 Then
MsgBox " You must enter a number greater than zero"
Exit Sub
End If
strTxt = Application.InputBox("Enter the text string to search on. Rows will be inserted below each cell containing this string.")
If Len(strTxt) < 1 Then
MsgBox "You must enter a text string consisting of at least one character"
Exit Sub
End If
With ActiveSheet
lngCount = Application.WorksheetFunction.CountIf(.Range("C1:C" & lastrow), strTxt)
If lngCount < 1 Then
MsgBox "The text string you entered is not listed - cancelling", vbExclamation
Exit Sub
End If
On Error Resume Next
For i = lastrow To 1 Step -1
If .Cells(i, 3).Value = strTxt Then
.Range("C" & i + 1 & ":C" & i + lRows).Insert shift:=xlDown
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
Every insert row will be 2 and I would like to add text to the two cells.
example:
apple
pear
bananna
(scripts inserts 2 rows after every occasion of bananna)
inserted row 1 ( text string included = "help")
inserted row 2 (text string included = "me")
peach
strawberry
end example
Can this be done?
The code Im using ->
Option Explicit
Sub Insert_Rows()
Dim i As Long, lRows As Long, lastrow As Long, lngCount As Long
Dim strTxt As String
Application.ScreenUpdating = False
lastrow = Cells(Rows.Count, "C").End(xlUp).Row
lRows = Application.InputBox("How many rows do you want to insert?", Type:=1)
If lRows < 1 Then
MsgBox " You must enter a number greater than zero"
Exit Sub
End If
strTxt = Application.InputBox("Enter the text string to search on. Rows will be inserted below each cell containing this string.")
If Len(strTxt) < 1 Then
MsgBox "You must enter a text string consisting of at least one character"
Exit Sub
End If
With ActiveSheet
lngCount = Application.WorksheetFunction.CountIf(.Range("C1:C" & lastrow), strTxt)
If lngCount < 1 Then
MsgBox "The text string you entered is not listed - cancelling", vbExclamation
Exit Sub
End If
On Error Resume Next
For i = lastrow To 1 Step -1
If .Cells(i, 3).Value = strTxt Then
.Range("C" & i + 1 & ":C" & i + lRows).Insert shift:=xlDown
End If
Next i
End With
Application.ScreenUpdating = True
End Sub