Split the text in the first column into several columns

Question

I'm not very well acquainted with VBA in general, and Excel programming kind of throws me off a bit compared to what I am used to (mostly assembly language).

Basically, a machine at my plant puts all the data that it records into an excel sheet; it labels everything and it records every datum, but it keeps all the data in a single cell for every cycle in the first column, so I'll have like 500 rows that are archived every day. I am trying to analyze and separate that data in every single cell so I can graph it and hopefully prove a solution to some of the problems I'm having.

Any help I can get with creating some sort of program I can run to split the data in multiple excel sheets into the same excel sheet but into multiple columns would be greatly appreciated. Just a note, all the different data is separated by semi colons.

So I am using the following data to loop through all of my excel sheets in a given folder. I got this code from another developer:

Sub AllWorkbooks()
    Dim MyFolder As String 'Path collected from the folder picker dialog    
    Dim MyFile As String 'Filename obtained by DIR function   
    Dim wbk As Workbook 'Used to loop through each workbook

    On Error Resume Next

    Application.ScreenUpdating = False

    'Opens the folder picker dialog to allow user selection
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please select a folder"
        .Show    
        .AllowMultiSelect = False
        If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
            MsgBox "You did not select a folder"    
            Exit Sub
        End If

        MyFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder
    End With

    MyFile = Dir(MyFolder) 'DIR gets the first file of the folder

    'Loop through all files in a folder until DIR cannot find anymore
    Do While MyFile <> ""    
        'Opens the file and assigns to the wbk variable for future use    
        Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)    
        'Replace the line below with the statements you would want your macro to perform    
        Call Filter    
        Call Rearrange    
        wbk.Close savechanges:=True    
        MyFile = Dir 'DIR gets the next file in the folder    
    Loop

    Application.ScreenUpdating = True 
End Sub



Sub Filter()
    With ActiveSheet.UsedRange
        .Columns.AutoFit
        .Rows.AutoFit
    End With

    If Not ActiveSheet.AutoFilterMode Then
        ActiveSheet.Range("A1").AutoFilter
    End If 
End Sub



Sub Rearrange()
    '
    ' Rearrange Macro
    ' Split all the data in the individual cells in the first column into individual columns.
    '
    ' Keyboard Shortcut: Ctrl+Shift+R
    '
    Rows("2:2").Select
    Selection.Delete Shift:=xlUp
    Rows("1:1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=True, Comma:=False, 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), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1)), TrailingMinusNumbers:=True
    Columns("A:A").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select

    Rows("1:1").Select
    Range("G1").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("G1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.AutoFilter
    ActiveSheet.Range("$G$1:$AC$8000").AutoFilter Field:=1
    Range("G1").Select
End Sub

The issue is, I cannot for the life of me get the first row to apply a filter, nor can I get the columns to AutoFit. Any Advice here?

Just use the built in [Split text into different columns with the Convert Text to Columns Wizard](https://support.office.com/en-us/article/split-text-into-different-columns-with-the-convert-text-to-columns-wizard-30b14928-5550-41f5-97ca-7a3e9c363ed7). If you need some VBA code use the Macro Recorder for a first idea and improve that code to your needs. If you get stuck or errors come back with your code and ask a question to it. — Pᴇʜ, Oct 29 '18 at 11:06
That depends on the format of the data put in the first cell. Is it separated by some delimiter or does it have fixed length? It would help if you included some samples in your question. — z32a7ul, Oct 29 '18 at 11:11
@z32a7ul obviously separated by semi colons: *"Just a note, all the different data is separated by semi colons."* — Pᴇʜ, Oct 29 '18 at 11:12
@Pᴇʜ, I have thousands upon thousands of excel sheets to filter through, and it would take me an eternity to do that for every single sheet. That's why I'm trying to write a Macro to do it for me, and hopefully do more than one sheet at a time. — Noah Thomas, Oct 29 '18 at 11:35
Well, please understand that this is no free code writing service (see [ask] and [No attempt was made](http://idownvotedbecau.se/noattempt/)). So before asking you should do some research and try something on your own. A good starting point is the Macro Recorder doing it manually with the wizard and record it as a macro. Then start building a loop around it that loops through all worksheets. Give it a try, then include the code you have into your question and ask something related to it. — Pᴇʜ, Oct 29 '18 at 12:01
Agree with @Pᴇʜ. Just want to add that the problem outlined in the comment is different from the one in the title: one thing is to split a semi colons-delimited string, and another is looping through all sheets in workbook (take a look [here](https://stackoverflow.com/a/36623279/1726522) just for an example). — CMArg, Oct 29 '18 at 12:33
first of all you must remove `On Error Resume Next` to see your errors. Otherwise you cannot debug your code. This line hides all error messages, but it doesn't fix the errors they still occur, you just cannot see them. It's like closing your eyes. • The problem with your question is that you put everything into that question. What you should do is focus on one issue first, solve that issue and then move to the next issue - instead of trying to fix everything in one step. Start with getting your "TextToColumn" to work. — Pᴇʜ, Oct 29 '18 at 13:54
And read and apply [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) to (probably) fix most of your issues. — Pᴇʜ, Oct 29 '18 at 13:55

score 1 · Answer 1 · answered Oct 29 '18 at 12:47

Assuming that the original data did obviously not contain any semicolon (otherwise you should handle their escaping), that there is obviously no such thing as strings in quotation marks, inside which semicolons should not be interpreted as delimiters, and that empty fields are obviously not removed, try the code below. And next time, please show some effort of trying to solve the problem.

Option Explicit

Public Sub SplitFirstCells()
    Dim ewsTarget As Worksheet: Set ewsTarget = ActiveSheet
    Dim r As Long: For r = 1 To ewsTarget.UsedRange.Rows.Count
        Dim strValue As String: strValue = CStr(ewsTarget.Cells(r, 1).Value)
        Dim varParts As Variant: varParts = Split(strValue, ";")
        Dim c As Long: For c = LBound(varParts) To UBound(varParts)
            ewsTarget.Cells(r, 1 + c - LBound(varParts) + 1).Value = varParts(c)
        Next c
    Next r
End Sub

Note that built in features like [Range.TextToColumns Method](https://learn.microsoft.com/en-us/office/vba/api/Excel.Range.TextToColumns) are usually faster than looping with VBA. Which could matter because the OP has *"upon thousands of excel sheets"*. — Pᴇʜ, Oct 29 '18 at 13:45
It may be faster. That depends on many factors, e.g. if there are thousands of files, each containing ten cells, then opening them will take most of the time. I did not optimize for speed (e.g. setting the value of many cells at the same time would save the overhead of interprocess communication). I think the poster's main goal was to avoid the manual repetition of the task. Moreover, this approach is more general, and he will be able to learn more from it, and adapt to other problems. — z32a7ul, Oct 29 '18 at 16:47

Split the text in the first column into several columns

1 Answers1