asked on

Seperating name and returning matched values

I have a worksheet in Excel 2010 which I am attaching.
In the name column, I have names, dived by a semicolon. The name are lastname, initial. Some rows have two names, other three.
I cant find a way to divid the names, so that each name it on a seperate row, but that each of these seperate names takes the correct corresponding Date (column B) and Year (column C) with them. names.xlsx

Carlos Ramirez

Add a Sheet2 sheet and give this macro a try

Public Sub breakout()
Dim mystring, mymonth, myyear As String
Dim mypos As Integer

' Turn off screen updating for speed
Application.ScreenUpdating = False

' Setup Sheet 2
ActiveWorkbook.Sheets("Sheet2").Select
Range("a1").Select

' Start in sheet 1, cell 1
ActiveWorkbook.Sheets("Sheet1").Select
Range("a1").Select

' loop consecutive cells (including header)

Do While ActiveCell.Value <> ""

' memorize values in row
mystring = ActiveCell.Value
mymonth = ActiveCell.Offset(0, 1).Value
myyear = ActiveCell.Offset(0, 2).Value

' Find semi-colon
If InStr(1, mystring, ";") > 0 Then
' jump to sheet 2 for input
ActiveWorkbook.Sheets("Sheet2").Select

' scan for semi-colons
Do While InStr(1, mystring, ";") > 0

mypos = InStr(1, mystring, ";")

' Write information to sheet2
ActiveCell.Value = Mid(mystring, 1, mypos - 1)
ActiveCell.Offset(0, 1).Value = mymonth
ActiveCell.Offset(0, 2).Value = myyear

' position in next cell
ActiveCell.Offset(1, 0).Select

' remove name from string
mystring = Trim(Mid(mystring, mypos + 1, 999))
Loop
' output last value
ActiveCell.Value = Mid(mystring, 1, 999)
ActiveCell.Offset(0, 1).Value = mymonth
ActiveCell.Offset(0, 2).Value = myyear

' position in next cell
ActiveCell.Offset(1, 0).Select

' Return to sheet 1
ActiveWorkbook.Sheets("Sheet1").Select
Else
' Write single name/title to sheet 2
ActiveWorkbook.Sheets("Sheet2").Select
ActiveCell.Value = mystring
ActiveCell.Offset(0, 1).Value = mymonth
ActiveCell.Offset(0, 2).Value = myyear
ActiveCell.Offset(1, 0).Select

' Return to sheet 1
ActiveWorkbook.Sheets("Sheet1").Select
End If

' jump to next cell
ActiveCell.Offset(1, 0).Select
Loop

' Turn on screen updating
Application.ScreenUpdating = True

End Sub

ASKER CERTIFIED SOLUTION

Patrick Matthews

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Patrick Matthews

Friendly aside to slycoder:

>> Dim mystring, mymonth, myyear As String

That is a legal statement, but it actually makes mystring and mymonth Variants, and not Strings. Rather, you
probably meant to use:

Dim mystring As String, mymonth As String, myyear As String

:)

Patrick