Trying to modify this 'text to rows' code to only use semicolons as delimiters

Hello All,

I've been trying to modify the below code to only require one semicolon as a delimiter between the data I need separated.

I currently have data like this 'John Smith;Ed Jones;Bob Thomas' which is all in a single cell, but I want to separate the names into individual rows, copying and inserting the data from all of the rows like this current code does.

I believe I can omit most of the bottom half since I'm only dealing with one delimiter, not parenthesis and brackets like this macro does.

Please let me know if you need any other information.

Sub Macro1() 
     '
    Dim lngRow As Long 
    Dim strTemp As String 
    Dim intPos As Integer 
    Dim intPosEnd As Integer 
    Dim lngRow2 As Long 
    Dim intCityCol As Integer 
     
    intCityCol = 1 
    lngRow = 2 
    With ActiveSheet 
        Do While .Cells(lngRow, intCityCol) <> "" 
            lngRow2 = lngRow 
            strTemp = .Cells(lngRow, intCityCol) 
            intPos = InStr(strTemp, "[") 
            If intPos > 0 Then 
                intPosEnd = InStr(intPos, strTemp, "]") 
                If intPosEnd > 0 Then 
                    lngRow2 = lngRow2 + 1 
                    .Rows(lngRow).Copy 
                    .Rows(lngRow).Insert Shift:=xlDown 
                    .Cells(lngRow + 1, intCityCol) = Mid(strTemp, intPos + 1, intPosEnd - intPos - 1) & Right(strTemp, 4) 
                    strTemp = Left(strTemp, intPos - intCityCol) & Trim(Mid(strTemp, intPosEnd + 1)) 
                    .Cells(lngRow, intCityCol) = strTemp 
                End If 
            End If 
;;------- I don't think I need this part since I don't have multiple delimiters (but not sure) ---
            intPos = InStr(strTemp, "(") 
            If intPos > 0 Then 
                intPosEnd = InStr(intPos, strTemp, ")") 
                If intPosEnd > 0 Then 
                    lngRow2 = lngRow2 + 1 
                    .Rows(lngRow).Copy 
                    .Rows(lngRow).Insert Shift:=xlDown 
                    .Cells(lngRow + 1, intCityCol) = Mid(strTemp, intPos + 1, intPosEnd - intPos - 1) & Right(strTemp, 4) 
                    strTemp = Left(strTemp, intPos - 1) & Trim(Mid(strTemp, intPosEnd + 1)) 
                    .Cells(lngRow, intCityCol) = strTemp 
                End If 
            End If 
;; -----------------------------------------------------------------------
            lngRow = lngRow2 + 1 
        Loop 
    End With 
End Sub

Thanks!
Mike

I kept plugging away at this and was able to accomplish what I needed with the following. The find and replace below the variables removes the OU information from the users.

Option Explicit
Sub Macro1()
     '
    Dim fullRow As Long
    Dim fullRow2 As Long
    Dim strTemp As String
    Dim intPos As Integer
    Dim intNameCol As Integer
     
    Cells.Find(What:="(*)", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    Cells.FindNext(After:=ActiveCell).Activate
    Cells.Replace What:="(*)", Replacement:="  ", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
     
    intNameCol = 5
    fullRow = 2
    With ActiveSheet
        Do While .Cells(fullRow, intNameCol) <> ""
            fullRow2 = fullRow
            strTemp = .Cells(fullRow, intNameCol)
            intPos = InStr(strTemp, ";")
            If intPos > 0 Then
                    fullRow2 = fullRow2 + 1
                    .Rows(fullRow).Copy
                    .Rows(fullRow).Insert Shift:=xlDown
                    .Cells(fullRow + 1, intNameCol) = Mid(strTemp, intPos + 3)
                    strTemp = Left(strTemp, intPos - intNameCol)
                    .Cells(fullRow, intNameCol) = strTemp
            End If
            fullRow = fullRow2 + 1
        Loop
    End With
End Sub