2

So essentially I have a large amount of data all in 1 cell seperated by commas. I have multiple rows of this data and with different amounts of data in each cell. Ex: first row may have data seperated by 3 commas, so it will become 3 columns. However, the 2nd row may have data seperated by 10 commas, which will become 10 columns. When I record the macro of transferring my text into columns, I get this code: 

Sub Macro2()
'
' Macro2 Macro
'

'
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, 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), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1)) _
        , TrailingMinusNumbers:=True
End Sub

Now, as I've mentioned the amount of data varies per row, and the data set will always change. Is there a way to have the array set so it becomes Array(last column, 1) ? Without having to actually enter them all manually to make sure it captures the whole data?

Adrian Mole
  • 49,934
  • 160
  • 51
  • 83
Joel Bastien
  • 121
  • 2
  • 11

2 Answers2

2

We can use the Split() function to parse each record. Before:

enter image description here

The code:

Sub Parse()
    Dim i As Long, N As Long, v As String, u As Long
    N = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To N
        v = Cells(i, 1).Value
        If v <> "" Then
            arr = Split(v, ",")
            u = UBound(arr) + 1
            Range(Cells(i, 1), Cells(i, u)).Value = arr
        End If
    Next i
End Sub

and after:

enter image description here

NOTE:

You can get similar results with formulas only (no VBA). For example, with data in column A, in B1 enter:

=TRIM(MID(SUBSTITUTE($A1,",",REPT(" ",999)),COLUMNS($A:A)*999-998,999))

and copy both across and downward.

EDIT#1:

  1. the line with Split() takes the contents of a single cell and separates it into an array of items
  2. the line with u figures out how many items are in the array
  3. the line with Range() deposits the array into a set of cells in the row.
Gary's Student
  • 95,722
  • 10
  • 59
  • 99
  • Works great thanks! I'm somewhat new to VBA and I'm trying to not only make the code work, but to actually understand what's going on so i can replicate/adjust it if ever i need to. I'm not quite sure I understand the last part of the code you put in. Would you mind explaining it for me step by step? This is the part I don't quite understand: v = Cells(i, 1).Value If v <> "" Then arr = Split(v, ",") u = UBound(arr) + 1 Range(Cells(i, 1), Cells(i, u)).Value = arr – Joel Bastien Dec 23 '18 at 16:47
  • @JoelBastien See my **EDIT#1** – Gary's Student Dec 23 '18 at 17:07
  • Thanks a lot! One last question. When I'm running my macro, it usually does a small portion of the data before stopping. Any idea why it does so? It'll do like 9 or so lines and then just move on to the next part of my macro for some reason. However, when i run it line by line with F8, it'll do all lines fine. Any idea? – Joel Bastien Dec 23 '18 at 19:05
  • @JoelBastien I am not sure. – Gary's Student Dec 23 '18 at 19:13
  • There's a Lesson (VBA): Imagine that I thought, even claimed that you can paste (deposit) an array into a range only if the array was 2D usually looping through the 1D array and copying to the 2D starting with e.g. Redim arr2D(1 to UBound(arr1D) + 1,1 To 1) to later be able to write rng = arr2D. And the cherry on top is that this is an array transposed into the range (rows into columns). Huge lesson. Thx. – VBasic2008 Dec 24 '18 at 23:12
0

TextToColumns feat. Field Info

You don't have to care about this argument and its parameter. The rest of the arguments missing had default values. Just shorten e.g. like this:

Sub TextToColumnsFieldInfo()

  Const cColumn As Variant = "A"     ' Source Column Letter/Number
  Const cFirst As Long = 1           ' Source First Row
  Const cTarget As String = "B1"     ' Target Cell

'  ' To suppress the following message:
'  ' "Do you want to replace the contents of the destination cells?"
'  Application.DisplayAlerts = False
'  On Error GoTo ProcedureExit

  Cells(cFirst, cColumn).Resize(Cells(Rows.Count, cColumn) _
      .End(xlUp).Row - cFirst + 1).TextToColumns _
      Destination:=Range(cTarget), Tab:=True, Comma:=True, _
      TrailingMinusNumbers:=True

'ProcedureExit:
'  Application.DisplayAlerts = True

End Sub

Remarks

  • This code is pasting into the B-column. Adjust the cTarget's parameter to fit your needs.
  • The Cells object is preferred because you can enter the column as letter or as number.
  • With the Resize method we adjust to the needed range.
  • The last row of data in column A is calculated to not apply TextToColumns to the whole column.
  • If you don't want to see the message that appears when overwriting data while using TextToColumns, uncomment the commented lines in the code.
VBasic2008
  • 44,888
  • 5
  • 17
  • 28