Consulting

Results 1 to 5 of 5

Thread: Macro for Splitting Information Contained Within a Column

  1. #1
    VBAX Regular
    Joined
    Jun 2007
    Location
    Texas
    Posts
    62
    Location

    Macro for Splitting Information Contained Within a Column

    I have inherited the following macro that doesn't quite work the way it is needed.

    What is needed is the ability to take information that is in a column which has commas separating the information and create a new line for each one. This macro seems to work for the first column or two that I try it on, but then after that I get a debug at the ".Value = .Value" location near the bottom.

    Also, is there a way to select multiple columns containing comma separated information instead of having to do them each individually? Information in the other columns need to just be copied with the new line information.

    Any help you can provide would be greatly appreciated.

    Option Explicit
    
    
    Sub Splt()
    Dim LR As Long, i As Long, LC As Integer
    Dim X As Variant
    Dim r As Range, iCol As Integer
    
    On Error Resume Next
    Set r = Application.InputBox("Click in the column to split by", Type:=8)
    On Error GoTo 0
    
    If r Is Nothing Then Exit Sub
    
    iCol = r.Column
    Application.ScreenUpdating = False
    
    LC = Cells(1, Columns.Count).End(xlToLeft).Column
    LR = Cells(Rows.Count, iCol).End(xlUp).Row
    
    Columns(iCol).Insert
    
    For i = LR To 1 Step -1
        With Cells(i, iCol + 1)
            If InStr(.Value, ",") = 0 Then
                .Offset(, -1).Value = .Value
            Else
                X = Split(.Value, ",")
                .Offset(1).Resize(UBound(X)).EntireRow.Insert
                .Offset(, -1).Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)
            End If
        End With
    Next i
    
    Columns(iCol + 1).Delete
    LR = Cells(Rows.Count, iCol).End(xlUp).Row
    
    With Range(Cells(1, 1), Cells(LR, LC))
        On Error Resume Next
        .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
        On Error GoTo 0
        .Value = .Value
    End With
    
    Application.ScreenUpdating = True
    End Sub
    Last edited by SamT; 10-18-2016 at 03:30 AM.

  2. #2
    VBAX Expert
    Joined
    Sep 2016
    Posts
    788
    Location
    please upload the sample file which results in the error.

  3. #3
    VBAX Regular
    Joined
    Jun 2007
    Location
    Texas
    Posts
    62
    Location
    Quote Originally Posted by mana View Post
    please upload the sample file which results in the error.

    Here it is.

    SAMPLE DATA.xlsx

  4. #4
    VBAX Expert
    Joined
    Sep 2016
    Posts
    788
    Location
    Thanks.
    I tried your data and code.
    The results may be differnt from what you expect to get,
    but no error occurs?

  5. #5
    VBAX Regular
    Joined
    Jun 2007
    Location
    Texas
    Posts
    62
    Location
    Quote Originally Posted by mana View Post
    Thanks.
    I tried your data and code.
    The results may be differnt from what you expect to get,
    but no error occurs?

    Well, that is odd. It happens every time I run it on about the 3rd or 4th time. Thanks for looking at it.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •