Possible? find string and put in next cell...

[excelnewbie]

Good morning!

Is this possible?
I have the following list:

LastName FirstName
Stevans variant Stevens Marilyn
Rogers Brendon variant Brendan

I would like to find the string "variant" and take what ever is after
it and put it in the cell under it along with the first or last name
that goes with it. ex:

LastName FirstName
Stevans Marilyn
Stevens Marilyn
Rogers Brendon
Rogers Brendan

I am thinking that I have to use something like:
If CellContainsText("variant") Then

cut what ever is after it and paste it in next cell with first or last
name then clean it??

ThisWorkbook.worksheets("Sheet1").Columns("A:B").cells.Replace _
What:="variant", Replacement:="", _
SearchOrder:=xlByColumns, MatchCase:=True

?? any suggestions would be appreciated!

Thanks,
MC

 

[merjet]

Try this. It assumes the data is in columns A & B.

Sub Macro1()
Dim c As Range
Dim str1 As String
Dim iPos As Integer
For Each c In Range("A:B")
iPos = InStr(c, "variant")
If iPos > 0 Then
str1 = c
Rows(c.Row).Insert Shift:=xlDown
If c.Column = 1 Then
Cells(c.Row, 1) = Left(str1, iPos - 1)
Cells(c.Row - 1, 1) = Right(str1, Len(str1) - iPos - 7)
Cells(c.Row, 2) = c.Offset(0, 1)
Cells(c.Row - 1, 2) = c.Offset(0, 1)
Else ' c.Column = 2
Cells(c.Row, 2) = Left(str1, iPos - 1)
Cells(c.Row - 1, 2) = Right(str1, Len(str1) - iPos - 7)
Cells(c.Row, 1) = c.Offset(0, -1)
Cells(c.Row - 1, 1) = c.Offset(0, -1)
End If
End If
Next c
End Sub

HTH,
Merjet

 

[excelnewbie]

the whole thing is that I am comparing a sheet to that sheet looking
form matches.....thnks to Tom Ogilvy!

Set CompareRange = ThisWorkbook. _
worksheets("Sheet1").Range("A4:A80")
For Each x In Selection.Columns(1).cells
For Each y In CompareRange
If UCase(x) = UCase(y) And UCase(x.Offset(0, 1)) = UCase(y.Offset(0,
1)) Then
x.Offset(0, 2) = x & ", " & x.Offset(0, 1)
If x = 0 Then
x.Offset(0, 2) = ""
End If
End If
Next y
Next x

But now the list I am trying to match against contains "variants" as
mentioned above...so I was thinking that was the quickest solution or
can I use something like:

ElseIf UCase(x) = UCase(y) And CellContainsText(y.Offset(0, 1),
"variant") Then

which works fine since I am comparing last names first, but if the
lastname contains "variant" it won't match, this will flag if it
matches the lastname and the first name contains the string
"variant".... I was looking at using "like" but I couldn't get that to
work.

????

 

[Tom Ogilvy]

Which range would contain the entries which have variant, the x range
(Selection.Columns(1).cells) or the Y range
(Worksheets("Sheet1").Range("A4:A80")/CompareRange)?

 

[excelnewbie]

Hi Tom! Hope everything is well.

The variant is in the Y/Compare Range.

Thanks,

MC

 

[Tom Ogilvy]

This should do what you want

Sub Tester1()
Dim x As Range, y As Range
Dim y1 As Range, x1 As Range
Dim ya As String, yb As String
Dim CompareRange As Range
Dim sStr As String
Set CompareRange = ThisWorkbook. _
Worksheets("Sheet1").Range("A4:A80")
For Each x In Selection.Columns(1).Cells
For Each y In CompareRange
If UCase(x) = UCase(y) Or _
UCase(x.Offset(0, 1)) = UCase(y.Offset(0, 1)) Then
Set x1 = x.Offset(0, 1)
Set y1 = y.Offset(0, 1)
Select Case True
Case InStr(1, y, _
"variant", vbTextCompare) = 0 _
And InStr(1, y.Offset(0, 1), _
"variant", vbTextCompare) = 0
If UCase(x) = UCase(y) And _
UCase(x1) = UCase(y1) Then
x.Offset(0, 2) = x & ", " & x1
If IsNumeric(x) Then
If x = 0 Then
x.Offset(0, 2) = ""
End If
End If
End If
Case InStr(1, y, _
"variant", vbTextCompare) > 0 _
And InStr(1, y1, _
"variant", vbTextCompare) = 0
sStr = y.Value
sStr = Application.Trim( _
Application.Substitute(sStr, "variant", ""))
ya = Left(sStr, InStr(sStr, " ") - 1)
yb = Right(sStr, Len(sStr) - (Len(ya) + 1))
If UCase(x) = UCase(ya) Or UCase(x) = UCase(yb) And _
UCase(x1) = UCase(y1) Then
x.Offset(0, 2) = x & ", " & x1
End If
Case InStr(1, y, _
"variant", vbTextCompare) = 0 _
And InStr(1, y1, _
"variant", vbTextCompare) > 0

sStr = y1.Value
sStr = Application.Trim( _
Application.Substitute(sStr, "variant", ""))
ya = Left(sStr, InStr(sStr, " ") - 1)
yb = Right(sStr, Len(sStr) - (Len(ya) + 1))
If UCase(x1) = UCase(ya) Or UCase(x1) = UCase(yb) And _
UCase(x) = UCase(y) Then
x.Offset(0, 2) = x & ", " & x1
End If
End Select
End If
If IsNumeric(x) Then
If x = 0 Then
x.Offset(0, 2) = ""
End If
End If

Next y
Next x
End Sub

 

[excelnewbie]

Hi Tom,

It is amazing how you come up with this so quickly!

I tested the code, but it isn't working I am going to try to get
it to work.

Thanks soo much!,

MC

 

[excelnewbie]

Hey Tom


I got it! Just had to replace "variant" with " " instead of
""/nothing...

Thanks again!

MC


Merjet thank you too for your input!!!

 

[Tom Ogilvy]

I would have to be a mind reader to know about that <g>