Possible? find string and put in next cell...
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
|