need to create a macro to find a txt and insert and Prompt user for Text

[thereseexceljakubiak]

Hello. I am trying to write a macro that will search down column B, find a User Prompted Term, insert a blank row beneath it and continue this for all instances. I have managed to get this to work with the macro below.


HELP: What I am trying to achieve on my next step is to have the User Prompted again for the Text to have populated in the new, inserted rows ( all instances). Please let me know if this does not make sense. And the "Text" should go into the cell in column B. Thank you in advance for any help!

[pre]

Sub Insertextracolumns()
'
' Insertextracolumns Macro
'
Dim strReply As String
Dim lReply As Long

Set vFound = Cells.Find(What:=InputBox("Please Enter Term to Search For:"), _
After:=Cells(1, 1), LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

If strReply = vbNullString Then
lReply = MsgBox("Do you wish to cancel?", vbYesNo)
If lReply = vbYes Then
Exit Sub
Else

If Not vFound Is Nothing Then
vStart = vFound.Address
Do
Rows(vFound.Row + 1).Insert (xlShiftDown)
Set vFound = Cells.FindNext(vFound)
Loop Until vFound.Address = vStart
Else
MsgBox ("Not Found")
End If

End If
End If

End Sub

[/pre]

 

[Luke M]

How's this?

[pre]

Sub Insertextracolumns()
'
' Insertextracolumns Macro
'
Dim strReply As String
Dim lReply As Long

Set vfound = Cells.Find(What:=InputBox("Please Enter Term to Search For:"), _
After:=Cells(1, 1), LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

'NEW CODE
Dim newTerm As String
newTerm = InputBox("Please Enter Term to add:")

If strReply = vbNullString Then
lReply = MsgBox("Do you wish to cancel?", vbYesNo)
If lReply = vbYes Then
Exit Sub
Else
If Not vfound Is Nothing Then
vStart = vfound.Address
Do
Rows(vfound.Row + 1).Insert (xlShiftDown)

'NEW CODE
Cells(vfound.Row + 1, "B").Value = newTerm

Set vfound = Cells.FindNext(vfound)
Loop Until vfound.Address = vStart
Else
MsgBox ("Not Found")
End If
End If
End If

End Sub

[/pre]

 

[thereseexceljakubiak]

amazing! Thank you for your input! One more add on- if there is of repetitive IDS that are in Daily sections.


Day1

123

456

789

10


Day2

123

456

789

10


Currently the macro find all instances of (say for ex: 456) and inserts New Term so it looks like this:


Day1

123

456

New Term

789

10


Day2

123

456

New Term

789

10


What if I want it to start forward on Day 2, 3, 4,....not starting with all Days previous?

 

[Luke M]

How do you want to set the limit of where to start search? We could make it so you select the cell you want to start at (Day2) and run the code that looks like this:

[pre]

Sub Insertextracolumns()
'
' Insertextracolumns Macro
'
Dim strReply As String
Dim lReply As Long
Dim LastRow As Long

With ActiveSheet
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
End With

'CHANGED THIS LINE TO LIMIT START POINT
Set vfound = Range(Selection, Cells(LastRow, "B")).Find(What:=InputBox("Please Enter Term to Search For:"), _
After:=Selection, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

'NEW CODE
Dim newTerm As String
newTerm = InputBox("Please Enter Term to add:")

If strReply = vbNullString Then
lReply = MsgBox("Do you wish to cancel?", vbYesNo)
If lReply = vbYes Then
Exit Sub
Else
If Not vfound Is Nothing Then
vStart = vfound.Address
Do
Rows(vfound.Row + 1).Insert (xlShiftDown)

'NEW CODE
Cells(vfound.Row + 1, "B").Value = newTerm

Set vfound = Cells.FindNext(vfound)
Loop Until vfound.Address = vStart
Else
MsgBox ("Not Found")
End If
End If
End If

End Sub[/pre]
Otherwise, we'd want to write another input box for a value, find that value first, and use that cell as the start point (rather than using Selection

.

 

[thereseexceljakubiak]

sorry to be a pain! I appreciate all of your help!


If its not too much trouble, could we please modify the code to say find "DAy 2" and start from that point forward??

 

[thereseexceljakubiak]

oh and the "day 2" or starting point to find is in column A

 

[Luke M]

Never too much trouble. =P

I also noticed that our check for null string was in wrong spot, so I moved it around a little.

[pre]

Sub Insertextracolumns()

Dim strReply As String
Dim lReply As Long
Dim LastRow As Long
Dim StartCell As Range
Dim vFound As Range
Dim newTerm As String

With ActiveSheet
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
End With

'Prompt user for what day/value to look for to start at
Set StartCell = Range("A:A").Find(InputBox("What is the starting point? E.g., Day 2"))

'Adjust start cell to be something in col B
If StartCell Is Nothing Then
Set StartCell = Range("B1")
Else
Set StartCell = StartCell.Offset(0, 1)
End If

'Break this out to separate line, check for null
strReply = InputBox("Please Enter Term to Search For:")
If strReply = vbNullString Then
lReply = MsgBox("Do you wish to cancel?", vbYesNo)
If lReply = vbYes Then Exit Sub
End If

Set vFound = Range(StartCell, Cells(LastRow, "B")).Find(What:=strReply, _
After:=StartCell, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

newTerm = InputBox("Please Enter Term to add:")

If Not vFound Is Nothing Then
vStart = vFound.Address
Do
Rows(vFound.Row + 1).Insert (xlShiftDown)
Cells(vFound.Row + 1, "B").Value = newTerm
Set vFound = Cells.FindNext(vFound)
Loop Until vFound.Address = vStart
Else
MsgBox ("Not Found")
End If

End Sub

[/pre]

 

[thereseexceljakubiak]

You are awesome!!! If I could hug you....i would!

 

[SirJB7]

Hi, thereseexceljakubiak!

May I suggest you to change your nick name? It's too long and it overlaps the comment area making it unreadable.

Regards!