split multiple semicolon separated values into new rows for multiple columns

Sub SplitColumns()
    Dim SP(2 To 3), TX$(2 To 3), UB&(2 To 3)

                            AR = [A1].CurrentRegion.Value
                            U& = UBound(AR, 2):  If U < 3 Then Exit Sub
                            B& = UBound(AR)
    Application.ScreenUpdating = False
                            W& = 1
    For R& = 2 To B
        For C& = 2 To 3
            SP(C) = Split(AR(R, C), ";")
            UB(C) = UBound(SP(C))
            If UB(C) < 0 Then TX(C) = "" Else TX(C) = Trim$(SP(C)(UB(C)))
        Next C

        For N& = 0 To UB(2 - (UB(3) > UB(2)))
            W = W + 1

            For C = 1 To U
                With Cells(W, C)
                    Select Case C
                           Case 2, 3
                                If N < UB(C) Then .Value = Trim$(SP(C)(N)) Else .Value = TX(C)

                           Case Else
                                .Value = AR(R, C)
                    End Select
                End With
            Next C
        Next N
    Next R

    For C = 1 To U
        Cells(B + 1, C).Resize(W - B).NumberFormat = Cells(2, C).NumberFormat
    Next

    Application.ScreenUpdating = True
    End
End Sub

Hope my reputation will increase …