VB Sctipt to seperate cell data separate by semi-colons into separate rows,

Posted on 2012-08-28
Last Modified: 2012-08-28
I have an Excel spreadsheet (exported from an Access DB) with 2 columns and roughly 2000 rows.  The first column has a network username and the second column has all of the security groups that the username belongs to delimited by semi-colons. It currently looks like this:

Username     Security Groups
Admin            Domain Users; HL Users; LC VPN SSL Only
Support            Domain Users; HL EH Animal Control; HL EH Users; HL Users; LC VPN SSL Only

I need the data in the second Security Groups column to be separated into different rows and for each of those rows to still contain the first column with the Username.  I would like it to look like this:

Username     Security Groups
Admin           Domain Users
Admin           HL Users
Admin           LC VPN SSL Only
Support           Domain Users
Support           HL EH Animal Control
Support           HL EH Users
Support           HL Users
Support           LC VPN SSL Only

Can someone please either help me with a VB script that I can run within Excel or a query that I can run within Access to accomplish this?
Thank you in advance.
Question by:HLR6S
    LVL 10

    Accepted Solution

    The subroutine that follows will create a new worksheet with the results you desire:
    Sub SplitGroups()
    Dim fromRow As Long
    Dim fromSheet As Worksheet
    Dim group As Variant
    Dim groups() As String
    Dim toRow As Long
    Dim toSheet As Worksheet
        Set fromSheet = ActiveSheet
        Sheets.Add After:=Sheets(Sheets.Count)
        Set toSheet = ActiveSheet
        toSheet.Cells(1, 1) = fromSheet.Cells(1, 1)
        toSheet.Cells(1, 2) = fromSheet.Cells(1, 2)
        fromRow = 2
        toRow = 2
        Do While Not IsEmpty(fromSheet.Cells(fromRow, 1).Value)
            groups = Split(fromSheet.Cells(fromRow, 2).Value, ";")
            For Each group In groups
                toSheet.Cells(toRow, 1) = fromSheet.Cells(fromRow, 1)
                toSheet.Cells(toRow, 2) = Trim(group)
                toRow = toRow + 1
            Next group
            fromRow = fromRow + 1
    End Sub

    Open in new window

    LVL 10

    Expert Comment

    VBA Script:
    Sub SplitContents()
    Dim i As Long
    Dim pos As Integer

    i = 2
    While (Cells(i, 1) <> "")
      pos = InStr(Cells(i, 2), ";")
      If (pos > 0) Then
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Cells(i, 1) = Cells(i + 1, 1)
        Cells(i, 2) = Left(Cells(i + 1, 2), pos - 1)
        Cells(i + 1, 2) = Mid(Cells(i + 1, 2), pos + 1)
      End If
      i = i + 1
    End Sub

    Featured Post

    Why You Should Analyze Threat Actor TTPs

    After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

    Join & Write a Comment

    Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
    Introduction The Visual Basic for Applications (VBA) language is at the heart of every application that you write. It is your key to taking Access beyond the world of wizards into a world where anything is possible. This article introduces you to…
    This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
    This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

    754 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

    Need Help in Real-Time?

    Connect with top rated Experts

    25 Experts available now in Live!

    Get 1:1 Help Now