Search code examples
excelvbastringdelimited

Delimitate Multi Lined Cells in Excel or VBA


Old Prompt

I've been trying to find a method of delimitating cells in Excel using the new line in the text with no luck. I need to delimitate a Cells string into multiple columns separated by the New Lines in the string so now I'm trying to find a way to do this with Visual Basics App. Does anyone have any useful advice or recommendations?

New Prompt

In the earlier portion of this assignment the goal was:

  • recognize Chr(10)
  • delimitate the text downward into a new column
  • keep the data from the same row

Previously I did not know there was a character that represented the new line. This is to say that I've found the solution to my problem and shared my results below.


Solution

  • OP ANSWER

    It's me again. I know this might seem a bit messy and maybe not as efficient as it could be, but this is essentially what I was looking for. I hope this helps anyone in the future. Feel free to message me with any questions or concerns.

    CODE

    Sub Test()
        Dim CountRows, FirstPortion, FullString, Row, Col
        
        'Manually Set This Value
        Row = 2
        Col = 4
        CountRows = 8
    '    '~~maybe i should count number of rows and increase count each time that a row is delimitated
    '    '~~~or just the same increase count when a new row is inserted
    '    '~~this would avoid the process of rechecking that a row has more to be delimitated
        '------------------------------***{ROW TRAVERSAL}***---------------------------------
        Do While Row < CountRows + 1
            
            '---------------------------***{INITIALIZE}***-----------------------------------
            FullString = Cells(Row, Col)
            Debug.Print "Row"; Row; ":"; "FullString:"
            Debug.Print FullString
            
            
            '--------------------------***{REPLACEMENT}***----------------------------------
            'If the row we point to contains a new line char then we want to replace newlines with "."
            If InStr(FullString, Chr(10)) > 0 Then
                
                Debug.Print "Row"; Row; " Info:"; " There is more than one line"
    '            'replaces new line char with periods
                FullString = Trim(Replace(FullString, Chr(10), "."))
                Debug.Print "Row"; Row; ":"; "FullString:"
                Debug.Print FullString
                
    '            'counts number of periods in the current row
    '            '****{might not need}****
    '            Count = Len(Cells(Row, Col)) - Len(Replace(Cells(Row, 4), ".", ""))
    
            End If
            
            
            '---------------------------***{EXTRACTION}***----------------------------------
            '------------------------------***{LOOP}***----------------------------------
            'If the Row we point to contains a "." then that implies there is more names to be delimitated
            'Knowing this we want to isolate the first portion of the String and isolate the remaining portion
            'the remaining portion should be moved to the next inserted row
            If InStr(FullString, ".") > 0 Then
            
                Debug.Print "Row"; Row; " Info:"; " There is more than one period"
                FirstPortion = Left(FullString, InStr(FullString, ".") - 1)
                Debug.Print "Row"; Row; ":"; "FirstPortion:"
                Debug.Print FirstPortion
                FullString = Right(FullString, (Len(FullString) - Len(FirstPortion) - 1))
                Debug.Print "Row"; Row; ":"; "FullString:"
                Debug.Print FullString
                
                '-----------------------***{INSERTION}***----------------------------------
                'Now that the strings are seperated we must insert a new row to move the information to
                Rows(Row + 1).Insert
                CountRows = CountRows + 1
                Debug.Print "Update the Row Count:"; CountRows
                
                '-----------------------***{COPY DATA}***-----------------------------------
                'Copy the relative data into the new row
                Rows(Row).Copy Rows(Row + 1)
                
                '-------------------***{DELIMITATE NAMES}***--------------------------------
                'Set Current Row to first name to be delimitated
                Cells(Row, Col) = FirstPortion
                'Set Next Row to remaining names
                Cells(Row + 1, Col) = FullString
                
            End If
            
            Row = Row + 1
            Debug.Print "Row Pointing to:"; Row
            
        Loop
        Exit Sub
    End Sub
    

    DUMMY DATA

    enter image description here

    RESULT

    enter image description here