Rework Split code

Hi,

I found some code in the database that may solve an issue for me. I am trying to split names in a cell using comma and then insert a new row each time.

Im getting the error message

"Method 'Range of Object' Global' failed

Can anyone amend this code so it splits the names in column D and and inserts them in a new row underneath?

Thanks
Seamus
Sub HTH()
    Dim SiteCol As Range, Cell As Object
    Dim vArray As Variant
    Dim numCells As Integer
    
    Set SiteCol = Range("D:D")
    For Each Cell In SiteCol
        vArray = Split(Range(Cell).Value, ",")
        numCells = UBound(vArray)
        If numCells >= 1 Then
            For i = 1 To numCells
                ActiveCell.Offset(1).EntireRow.Insert
            Next i
            ActiveCell.Offset(1, 0).Select
            Range(Cell).Resize(UBound(vArray, 1) + 1).Value = WorksheetFunction.Transpose(vArray)
        End If
    Next
End Sub

Open in new window

test.xls
Seamus2626Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

borgunitCommented:
Not quite sure but is this what you are trying to accomplish?
Sub HTH()
    Dim SiteCol As Range, Cell As Object
    Dim vArray As Variant
    Dim numCells As Integer
    Dim i As Integer
    
    Set SiteCol = Range("D:D")
    For Each Cell In SiteCol
        vArray = Split(Cell, ",")
        numCells = UBound(vArray)
        If numCells >= 1 Then
            For i = 1 To numCells
                ActiveCell.Offset(1).EntireRow.Insert
            Next i
            ActiveCell.Offset(1, 0).Select
            Cell.Resize(UBound(vArray, 1) + 1).Value = WorksheetFunction.Transpose(vArray)
        End If
    Next
End Sub

Open in new window

0
Seamus2626Author Commented:
hey borgunit, what i am trying to do is as follows (in Shee1)

(1) Loop through Column D, when there is multiple names in a cell, seperate the names and insert a new row with  each name

The objective is to not have multiple names in cells, they need to be in individual cells, so where there is multiple names, a row needs to be inserted and the name moved to col D of the new row

(You can see i manually did this in tab example)

Thanks
Seamus
0
McOzCommented:
Try this and see if it works:
Sub HTH()
    Dim SiteCol As Range, c As Object
    Dim vArray As Variant
    Dim numCells As Integer
    
    Set SiteCol = Range("D:D")
    For Each c In SiteCol.Cells
        vArray = Split(c.Value, ",")
        numCells = Ubound(vArray)
        If numCells >= 1 Then
            For i = 1 To numCells
                ActiveCell.Offset(1).EntireRow.Insert
            Next i
            ActiveCell.Offset(1, 0).Select
            c.Resize(UBound(vArray, 1) + 1).Value = WorksheetFunction.Transpose(vArray)
        End If
    Next
End Sub

Open in new window


McOz
0
Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

Seamus2626Author Commented:
Thanks McOz, the code inserts the rows but the names have dissapeared!

I need the names to fall out in column D in the inserted rows

Seamus
0
borgunitCommented:
The code has no logic on its own. Make sure your "active cell" is selected
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
NorieVBA ExpertCommented:
Seamus

Where do you get the error you mentioned in the first post?
0
StephenJRCommented:
Seamus - this looks very much like your other question?
0
McOzCommented:
OK, I did some testing, this should do the trick:
 
Sub HTH()
    Dim SiteCol As Range, c As Object
    Dim vArray As Variant
    Dim numCells As Integer
    
    Set SiteCol = Range("D:D")
    For Each c In Intersect(SiteCol, ActiveSheet.UsedRange).Cells
        vArray = Split(c.Value, ",")
        numCells = UBound(vArray)
        If numCells >= 1 Then
            For i = 1 To numCells
                ActiveCell.Offset(1).EntireRow.Insert
            Next i
            c.Resize(UBound(vArray) + 1).Value = WorksheetFunction.Transpose(vArray)
            c.Offset(UBound(vArray) + 1).Select
        End If
    Next
End Sub

Open in new window


McOz
0
Seamus2626Author Commented:
I ran that again and it worked, thank you borgunit


Seamus
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.