Improve company productivity with a Business Account.Sign Up

x
?
Solved

Seperating name and returning matched values

Posted on 2011-09-09
3
Medium Priority
?
225 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
  • 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

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

After seeing numerous questions for Dynamic Data Validation I notice that most have used Visual Basic to solve the problem. This suggestion is purely formula based and can be used in multiple rows.
Windows Explorer let you handle zip folders nearly as any other folder: Copy, move, change, and delete, etc. In VBA you can also handle normal files and folders, but zip folders takes a little more - and that you'll find here.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

606 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