HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Parsing cells containing Line Feed Characters

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
containinglinefeedcellsparsingcharacters

Problem

Link to sanitized xls on dropbox if test data is needed

Essentially the reports I work with aren't bad -

The issue is the way it exports to excel -

With the problem being that these cells are filled with LF characters breaking apart the data entries in the cells (usually a listing of employees in format empID / emp name. There's really no rhyme or reason as to where it places the LFs - sometimes there are three in a row.

A lot of the time for analysis I need to use this data but first I need each person to have their own data (the reports get a lot bigger). Since I'm constantly writing and rewriting ways to do it, I figured I'd give it a shot at CR. I'm sure there's plenty to be improved.

One note - apparently when you set a range to an inputbox range and the user hits cancel, it errors before assigning anything into the range. I could not find any other way to handle it, so I put it in its own function to avoid any other errors that occur.

All one module. The top module would be called. I know the licensing conflict here, no need to mention it.

```
Option Explicit
'==========================================
'MIT License
'Copyright (c) @raymondwise
'==========================================
Public Sub ParseColumnFromWorkday()
Dim lastRow As Long
lastRow = 1

Dim workingRange As Range
Set workingRange = UserSelectRange(lastRow)

If workingRange Is Nothing Then
Exit Sub
End If
Application.ScreenUpdating = False
Dim workingColumn As Long
workingColumn = workingRange.Column
Dim currentRow As Long
Dim cellToParse As Range
Dim stringParts() As String

For currentRow = lastRow To 2 Step -1
Set cellToParse = Cells(currentRow, workingColumn)
stringParts = Split(cellToParse, vbLf)
If Len(Join(stringParts)) = 0 Then GoTo SkipLoop
cellToParse.Value = stringParts(0)
Dim i As Long
For i = 1 To UBound(stringParts)
If Len(stringParts(i)) >

Solution

This "guard clause" does not need to be a block:

If workingRange Is Nothing Then
    Exit Sub
End If


Inlining the Exit Sub makes it clearer that it's intended to be a "quick sanity check" and not something that's meant to eventually grow with special handling and additional code (like a block does) - in fact, it would be consistent with what you have in other places:

If columnToParse Is Nothing Then Exit Function


Indentation is uncalled for here:

Dim i As Long
        For i = 1 To UBound(stringParts)


The declaration of i and the For loop are technically at the same "level", and should be lined up.

Dim i As Long
    For i = 1 To UBound(stringParts)


Looking again at this validation part:

Set columnToParse = GetUserInputRange
If columnToParse Is Nothing Then Exit Function

If columnToParse.Columns.Count > 1 Then
    MsgBox "You selected multiple columns. Exiting.."
    Exit Function
End If


I think this might actually be better off in an error handler.

Set columnToParse = GetUserInputRange
If columnToParse Is Nothing Then Err.Raise ParseError.InputRangeIsNothing
If columnToParse.Columns.Count > 1 Then Err.Raise ParseError.MultipleColumnsSelected


Where ParseError could be a Private Enum that defines error codes for your implementation, typically starting with vbObjectError + 42.

And then the body of the procedure can focus on the "happy path" - while the error handler can Select Case on the error number, and handle as needed:

Case Error.InputRangeIsNothing
    Resume CleanExit
Case Error.MultipleColumnsSelected
    MsgBox "Multiple columns are selected. Please select only one.", vbExclamation
Case Else
    MsgBox "An error has occurred: " & Err.Description, vbCritical
    Resume CleanExit


If Len(Join(stringParts)) = 0 Then GoTo SkipLoop


This is pretty much the only acceptable use for a GoTo instruction - simulating a Continue statement.

But before doing that, I'd fix the indentation:

For currentRow = lastRow To 2 Step -1
        Set cellToParse = Cells(currentRow, workingColumn)
        stringParts = Split(cellToParse, vbLf)
            If Len(Join(stringParts)) = 0 Then GoTo SkipLoop
        cellToParse.Value = stringParts(0)
        Dim i As Long
            For i = 1 To UBound(stringParts)
                If Len(stringParts(i)) > 0 Then
                    cellToParse.EntireRow.Copy
                    cellToParse.EntireRow.Insert shift:=xlDown
                    cellToParse.Offset(-1) = stringParts(i)
                End If
            Next i
SkipLoop:
    Next currentRow


...and add some breathing space... and heck, I'd pay the price for the extra nesting and remove that GoTo.

For currentRow = lastRow To 2 Step -1

        Set cellToParse = Cells(currentRow, workingColumn)
        stringParts = Split(cellToParse, vbLf)

        If Len(Join(stringParts)) > 0 Then
            cellToParse.Value = stringParts(0)

            Dim i As Long
            For i = 1 To UBound(stringParts)
                If Len(stringParts(i)) > 0 Then
                    cellToParse.EntireRow.Copy
                    cellToParse.EntireRow.Insert shift:=xlDown
                    cellToParse.Offset(-1) = stringParts(i)
                End If
            Next i
        End If
    Next currentRow


...and then I'd extract a small private method for it:

Private Sub WhateverThisDoes(stringParts(), ByVal cellToParse As Range)
    cellToParse.Value = stringParts(0)
    Dim i As Long
    For i = 1 To UBound(stringParts)
        If Len(stringParts(i)) > 0 Then
            cellToParse.EntireRow.Copy
            cellToParse.EntireRow.Insert shift:=xlDown
            cellToParse.Offset(-1) = stringParts(i)
        End If
    Next i
End Sub


...which removes the nesting in the outer loop, and leaves you with smaller functions that do fewer things:

If Len(Join(stringParts)) > 0 Then WhateverThisDoes stringParts, cellToParse

Code Snippets

If workingRange Is Nothing Then
    Exit Sub
End If
If columnToParse Is Nothing Then Exit Function
Dim i As Long
        For i = 1 To UBound(stringParts)
Dim i As Long
    For i = 1 To UBound(stringParts)
Set columnToParse = GetUserInputRange
If columnToParse Is Nothing Then Exit Function

If columnToParse.Columns.Count > 1 Then
    MsgBox "You selected multiple columns. Exiting.."
    Exit Function
End If

Context

StackExchange Code Review Q#125698, answer score: 3

Revisions (0)

No revisions yet.