Macro to insert a cell after the selected cell
 

I have a huge database filled with data similar to the following set:

SCR SAW PI A HF RF
SCR SAW PI RF PI SCR
SCR SAW PI A HF RF
SCR SAW PI A HF RF

I'm looking for a macro that will prompt me for an input (ex. "SAW") and an
output (ex. "DB"). It would find every cell that contains the letters "SAW"
and insert a cell immediately to the right of it that contains the letters
"DB".

Macro to insert a cell after the selected cell
 

Sub pointr()
inpt = Application.InputBox(Prompt:="enter input", Type:=2)
outp = Application.InputBox(Prompt:="enter output", Type:=2)
Set rPush = Nothing
For Each r In ActiveSheet.UsedRange
If r.Value = inpt Then
If rPush Is Nothing Then
Set rPush = r
Else
Set rPush = Union(rPush, r)
End If
End If
Next

rPush.Insert Shift:=xlToRight
rPush.Offset(0, 1).Value = outp
End Sub

--
Gary''s Student - gsnu200836

Macro to insert a cell after the selected cell
 

This macro inserted a blank cell before the input cell. It didn't enter my
output information into the output cell, either.

"Gary''s Student" wrote:

Sub pointr()
inpt = Application.InputBox(Prompt:="enter input", Type:=2)
outp = Application.InputBox(Prompt:="enter output", Type:=2)
Set rPush = Nothing
For Each r In ActiveSheet.UsedRange
If r.Value = inpt Then
If rPush Is Nothing Then
Set rPush = r
Else
Set rPush = Union(rPush, r)
End If
End If
Next

rPush.Insert Shift:=xlToRight
rPush.Offset(0, 1).Value = outp
End Sub

--
Gary''s Student - gsnu200836

Macro to insert a cell after the selected cell
 

Sorry...inserted at the wrong place:

Sub pointr()
inpt = Application.InputBox(Prompt:="enter input", Type:=2)
outp = Application.InputBox(Prompt:="enter output", Type:=2)
Set rPush = Nothing
For Each r In ActiveSheet.UsedRange
If r.Value = inpt Then
If rPush Is Nothing Then
Set rPush = r
Else
Set rPush = Union(rPush, r)
End If
End If
Next
rPush.Offset(0, 1).Insert Shift:=xlToRight
rPush.Offset(0, 1).Value = outp
End Sub

--
Gary''s Student - gsnu200836


"PointerMan" wrote:

This macro inserted a blank cell before the input cell. It didn't enter my
output information into the output cell, either.

"Gary''s Student" wrote:

Sub pointr()
inpt = Application.InputBox(Prompt:="enter input", Type:=2)
outp = Application.InputBox(Prompt:="enter output", Type:=2)
Set rPush = Nothing
For Each r In ActiveSheet.UsedRange
If r.Value = inpt Then
If rPush Is Nothing Then
Set rPush = r
Else
Set rPush = Union(rPush, r)
End If
End If
Next

rPush.Insert Shift:=xlToRight
rPush.Offset(0, 1).Value = outp
End Sub

--
Gary''s Student - gsnu200836

Macro to insert a cell after the selected cell
 

That worked great! Thanks! One more question - if I wanted to do the same
thing but insert the new cell before the selected cell, which line would I
need to modify?

Thanks again!



"Gary''s Student" wrote:

Sorry...inserted at the wrong place:

Sub pointr()
inpt = Application.InputBox(Prompt:="enter input", Type:=2)
outp = Application.InputBox(Prompt:="enter output", Type:=2)
Set rPush = Nothing
For Each r In ActiveSheet.UsedRange
If r.Value = inpt Then
If rPush Is Nothing Then
Set rPush = r
Else
Set rPush = Union(rPush, r)
End If
End If
Next
rPush.Offset(0, 1).Insert Shift:=xlToRight
rPush.Offset(0, 1).Value = outp
End Sub

--
Gary''s Student - gsnu200836


"PointerMan" wrote:

This macro inserted a blank cell before the input cell. It didn't enter my
output information into the output cell, either.

"Gary''s Student" wrote:

Sub pointr()
inpt = Application.InputBox(Prompt:="enter input", Type:=2)
outp = Application.InputBox(Prompt:="enter output", Type:=2)
Set rPush = Nothing
For Each r In ActiveSheet.UsedRange
If r.Value = inpt Then
If rPush Is Nothing Then
Set rPush = r
Else
Set rPush = Union(rPush, r)
End If
End If
Next

rPush.Insert Shift:=xlToRight
rPush.Offset(0, 1).Value = outp
End Sub

--
Gary''s Student - gsnu200836

Macro to insert a cell after the selected cell
 

We change the last two lines:

Sub pointr()
inpt = Application.InputBox(Prompt:="enter input", Type:=2)
outp = Application.InputBox(Prompt:="enter output", Type:=2)
Set rPush = Nothing
For Each r In ActiveSheet.UsedRange
If r.Value = inpt Then
If rPush Is Nothing Then
Set rPush = r
Else
Set rPush = Union(rPush, r)
End If
End If
Next
rPush.Insert Shift:=xlToRight
rPush.Offset(0, -1).Value = outp
End Sub
--
Gary''s Student - gsnu200836


"PointerMan" wrote:

That worked great! Thanks! One more question - if I wanted to do the same
thing but insert the new cell before the selected cell, which line would I
need to modify?

Thanks again!



"Gary''s Student" wrote:

Sorry...inserted at the wrong place:

Sub pointr()
inpt = Application.InputBox(Prompt:="enter input", Type:=2)
outp = Application.InputBox(Prompt:="enter output", Type:=2)
Set rPush = Nothing
For Each r In ActiveSheet.UsedRange
If r.Value = inpt Then
If rPush Is Nothing Then
Set rPush = r
Else
Set rPush = Union(rPush, r)
End If
End If
Next
rPush.Offset(0, 1).Insert Shift:=xlToRight
rPush.Offset(0, 1).Value = outp
End Sub

--
Gary''s Student - gsnu200836


"PointerMan" wrote:

This macro inserted a blank cell before the input cell. It didn't enter my
output information into the output cell, either.

"Gary''s Student" wrote:

Sub pointr()
inpt = Application.InputBox(Prompt:="enter input", Type:=2)
outp = Application.InputBox(Prompt:="enter output", Type:=2)
Set rPush = Nothing
For Each r In ActiveSheet.UsedRange
If r.Value = inpt Then
If rPush Is Nothing Then
Set rPush = r
Else
Set rPush = Union(rPush, r)
End If
End If
Next

rPush.Insert Shift:=xlToRight
rPush.Offset(0, 1).Value = outp
End Sub

--
Gary''s Student - gsnu200836