[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 225
  • Last Modified:

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
0
LiamMcKay
Asked:
LiamMcKay
  • 2
1 Solution
 
slycoderCommented:
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
 
Patrick MatthewsCommented:
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
 
Patrick MatthewsCommented:
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: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

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.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now