Solved

Seperating name and returning matched values

Posted on 2011-09-09
3
198 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 92

Accepted Solution

by:
Patrick Matthews earned 125 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 92

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: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

839 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