?
Solved

Rework Split code

Posted on 2011-10-20
9
Medium Priority
?
315 Views
Last Modified: 2012-05-12
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
0
Comment
Question by:Seamus2626
  • 3
  • 2
  • 2
  • +2
9 Comments
 
LVL 10

Expert Comment

by:borgunit
ID: 36999129
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
 

Author Comment

by:Seamus2626
ID: 36999161
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
 
LVL 9

Expert Comment

by:McOz
ID: 36999248
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
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 

Author Comment

by:Seamus2626
ID: 36999297
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
 
LVL 10

Accepted Solution

by:
borgunit earned 2000 total points
ID: 36999457
The code has no logic on its own. Make sure your "active cell" is selected
0
 
LVL 35

Expert Comment

by:Norie
ID: 36999467
Seamus

Where do you get the error you mentioned in the first post?
0
 
LVL 24

Expert Comment

by:StephenJR
ID: 36999470
Seamus - this looks very much like your other question?
0
 
LVL 9

Expert Comment

by:McOz
ID: 37000064
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
 

Author Closing Comment

by:Seamus2626
ID: 37000065
I ran that again and it worked, thank you borgunit


Seamus
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes a serious pitfall that can happen when deleting shapes using VBA.
Windows Explorer lets you open cabinet (cab) files like any other folder. In VBA you can easily handle normal files and folders, but opening and indeed creating cabinet files takes a lot more - and that's you'll find here.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.

809 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