patternMinor
Parsing cells containing Line Feed Characters
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
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)) >
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:
Inlining the
Indentation is uncalled for here:
The declaration of
Looking again at this validation part:
I think this might actually be better off in an error handler.
Where
And then the body of the procedure can focus on the "happy path" - while the error handler can
This is pretty much the only acceptable use for a
But before doing that, I'd fix the indentation:
...and add some breathing space... and heck, I'd pay the price for the extra nesting and remove that
...and then I'd extract a small private method for it:
...which removes the nesting in the outer loop, and leaves you with smaller functions that do fewer things:
If workingRange Is Nothing Then
Exit Sub
End IfInlining 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 FunctionIndentation 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 IfI 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.MultipleColumnsSelectedWhere
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 CleanExitIf Len(Join(stringParts)) = 0 Then GoTo SkipLoopThis 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, cellToParseCode Snippets
If workingRange Is Nothing Then
Exit Sub
End IfIf columnToParse Is Nothing Then Exit FunctionDim 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 IfContext
StackExchange Code Review Q#125698, answer score: 3
Revisions (0)
No revisions yet.