none
VBA assistance to modify code RRS feed

  • Question

  • Hello All,

    I have a piece of code that almost works for what I need it to do. 
    Basically, I have data consisting of a variable number of column separated
    strings. example

    01AL,02AL,03AL,04AL

    When I run the code below

    Sub CommaSeparated()

    Dim curr_range As Range
    Dim Row As Range
    Dim arr As Variant
    Dim cell As Variant
    Dim output_str As String
    Dim output_arr As Variant

    Set curr_range = ActiveSheet.Range("A1:A9999")
        For Each Row In curr_range
            arr = Split(Row, ",")
             For Each cell In arr
                output_str = output_str & "," & cell

            Next cell

        Next Row
            output_str = Replace(output_str, " ", "")
              output_str = Right(output_str, Len(output_str) - 1)
                   output_arr = Split(output_str, ",")

        ActiveSheet.Range("A:A").Value = Application.WorksheetFunction.Transpose(output_arr)

    End Sub

    It gives me sixteen rows of:

    01AL
    02AL
    03AL 
    04AL
    01AL
    02AL
    03AL 
    04AL
    01AL
    02AL
    03AL 
    04AL
    01AL
    02AL
    03AL 
    04AL

    and a #VALUE down the rest of the column

    I was hoping to only get four rows of:

    01AL
    02AL
    03AL 
    04AL

    with no #VALUE down rest of column.

    Thank you in advance for any assistance/suggestions.

    Thomas Yantorno

    Monday, November 19, 2012 4:39 PM

Answers

  • And a slightly shorter version of the code:

    Sub CommaSeparated()
        Dim LastRow As Long
        Dim CurRow As Long
        Dim ValueList As String
        Dim arr As Variant
        LastRow = Range("A" & Rows.Count).End(xlUp).Row
        For CurRow = 1 To LastRow
            If Range("A" & CurRow).Value <> "" Then
                ValueList = ValueList & "," & Range("A" & CurRow).Value
            End If
        Next CurRow
        If ValueList <> "" Then
            ValueList = Mid(ValueList, 2)
            ValueList = Replace(ValueList, " ", "")
            arr = Split(ValueList, ",")
            LastRow = UBound(arr) + 1
            Range("A1:A" & LastRow).Value = Application.WorksheetFunction.Transpose(arr)
        End If
    End Sub


    Regards, Hans Vogelaar

    • Marked as answer by tyantorno Monday, November 19, 2012 5:10 PM
    Monday, November 19, 2012 5:02 PM

All replies

  • Change the line

    ActiveSheet.Range("A:A").Value = Application.WorksheetFunction.Transpose(output_arr)

    to

    ActiveSheet.Range("A1:A" & UBound(output_arr) + 1).Value = Application.WorksheetFunction.Transpose(output_arr)


    Regards, Hans Vogelaar

    Monday, November 19, 2012 4:54 PM
  • And a slightly shorter version of the code:

    Sub CommaSeparated()
        Dim LastRow As Long
        Dim CurRow As Long
        Dim ValueList As String
        Dim arr As Variant
        LastRow = Range("A" & Rows.Count).End(xlUp).Row
        For CurRow = 1 To LastRow
            If Range("A" & CurRow).Value <> "" Then
                ValueList = ValueList & "," & Range("A" & CurRow).Value
            End If
        Next CurRow
        If ValueList <> "" Then
            ValueList = Mid(ValueList, 2)
            ValueList = Replace(ValueList, " ", "")
            arr = Split(ValueList, ",")
            LastRow = UBound(arr) + 1
            Range("A1:A" & LastRow).Value = Application.WorksheetFunction.Transpose(arr)
        End If
    End Sub


    Regards, Hans Vogelaar

    • Marked as answer by tyantorno Monday, November 19, 2012 5:10 PM
    Monday, November 19, 2012 5:02 PM
  • Thank you Mr Vogelar,

    You have been extremely helpful, I know I need to clean up code a bit. I am relatively new and just getting it to do what I want is a chore lol. Have a great day Sir.


    Hello,

    I have been doing some testing and running into one issue. when there are four pieces of data separated by three commas it fills down sixteen rows rather than four, one row for each piece of data. Any suggestions would be greatly appreciated. Thank you again.

    Above is what is happening, below is what like to see happen

    Thank you.

    • Edited by tyantorno Monday, November 19, 2012 6:51 PM
    Monday, November 19, 2012 5:11 PM