?
Solved

Seperating name and returning matched values

Posted on 2011-09-09
3
Medium Priority
?
215 Views
Last Modified: 2012-05-12
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
0
Comment
Question by:LiamMcKay
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
3 Comments
 
LVL 5

Expert Comment

by:slycoder
ID: 36511257
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
0
 
LVL 93

Accepted Solution

by:
Patrick Matthews earned 500 total points
ID: 36511376
The following code seems to work for me.  It posts the results to a new worksheet:


Sub SplitRows()
    
    Dim ArrIn As Variant, ArrOut() As Variant
    Dim LastR As Long
    Dim DestR As Long
    Dim Counter As Long
    Dim Names As Variant
    Dim NameCounter As Long
    
    With ActiveSheet
        LastR = .Cells(.Rows.Count, "a").End(xlUp).Row
        ArrIn = .Range("a1:c" & LastR).Value
    End With
    
    For Counter = 1 To UBound(ArrIn, 1)
        If Counter = 1 Then
            DestR = 1
            ReDim ArrOut(1 To 3, 1 To 1) As Variant
            ArrOut(1, 1) = ArrIn(1, 1)
            ArrOut(2, 1) = ArrIn(1, 2)
            ArrOut(3, 1) = ArrIn(1, 3)
        Else
            Names = Split(ArrIn(Counter, 1), ";")
            For NameCounter = LBound(Names) To UBound(Names)
                DestR = DestR + 1
                ReDim Preserve ArrOut(1 To 3, 1 To DestR)
                ArrOut(1, DestR) = Trim(Names(NameCounter))
                ArrOut(2, DestR) = ArrIn(Counter, 2)
                ArrOut(3, DestR) = ArrIn(Counter, 3)
            Next
        End If
    Next
    
    Worksheets.Add
    Range("a1:c" & DestR).Value = Application.Transpose(ArrOut)
    Range("1:1").Font.Bold = True
    Columns.AutoFit
    
End Sub

Open in new window

0
 
LVL 93

Expert Comment

by:Patrick Matthews
ID: 36511404
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
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

752 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question