Home > database >  Excel Text to Columns in VBA with variable number of delimiters in each row?
Excel Text to Columns in VBA with variable number of delimiters in each row?

Time:09-22

I am processing instructor evaluations for a college in an Excel file. One row represents one course section and contains all student comments for that section. The number of comments may be anywhere from 0 on up for a course section and they are concatenated together with a tilde ("~") delimiter in a single column.

tilde separated rows
example tilde separated rows

I am tasked with doing a Text to Column separation. I want to automate this rather than using Text to Column in the menu. I've found the number of columns required by counting the number of tilde in each row and used the max number as the number of columns I need to create.

To start, I recorded a macro using the Text to Columns menu function and got this:

Columns("B:B").Select
Selection.TextToColumns Destination:=Range("qNine_2[[#Headers],[Q9_1]]"), _
    DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter _
    :=False, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, _
    Other:=True, OtherChar:="~", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array _
    (3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array( _
    10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), _
    Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1)), _
    TrailingMinusNumbers:=True

My problem is I can't seem to create a loop that will populate the FieldInfo attribute.

This is the loop I created but it doesn't work. qNine_2 is the table the data exists in, q9_1, is the column with the concatenated comments, q9_max contains the number of columns to create:

Dim FieldValues() As Variant
Dim x As Integer
Dim tempArray(2) As Integer

tempArray(1) = 2

ReDim FieldValues(q9_max)

For x = 0 To q9_max - 1
    tempArray(0) = x   1
    FieldValues(x) = tempArray
Next x

Columns("B:B").Select
Selection.TextToColumns Destination:=Range("qNine_2[[#Headers],[Q9_1]]"), _
    DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="~", _
    FieldInfo:=FieldValues, _
    TrailingMinusNumbers:=True

I get: Run-time error '13' type mismatch error

and the debugger shows

debugger

I don't understand why this doesn't work. To the best of my knowledge shouldn't this be true?:

FieldValues = Array(Array(1, 1), Array(2, 1), Array _
        (3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array( _
        10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), _
        Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1))

CodePudding user response:

Sub SplitOnTilde()

    Dim FieldValues() As Variant
    Dim i As Integer, q9_max As Integer

    q9_max = 10 ' number of ~
    ReDim FieldValues(q9_max)
    For i = 0 To q9_max
        FieldValues(i) = Array(i   1, 2) ' 2 - text
    Next
    
    Columns("B:B").Select
    Selection.TextToColumns Destination:=Range("qNine_2[[#Headers],[Q9_1]]"), _
        DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False, _
        Space:=False, Other:=True, OtherChar:="~", _
        FieldInfo:=FieldValues, _
        TrailingMinusNumbers:=True
End Sub
  • Related