5
\$\begingroup\$

Link to sanitized xls on dropbox if test data is needed

Essentially the reports I work with aren't bad -

enter image description here

The issue is the way it exports to excel -

enter image description here

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) <2016> <Raymond Wise> <https://github.com/RaymondWise/Excel-Workday-Report-Parser> @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)) > 0 Then
                    cellToParse.EntireRow.Copy
                    cellToParse.EntireRow.Insert shift:=xlDown
                    cellToParse.Offset(-1) = stringParts(i)
                End If
            Next i
SkipLoop:
    Next currentRow
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Supporting Cast

Private Function UserSelectRange(ByRef lastRow As Long) As Range
    Set UserSelectRange = Nothing
    Dim columnToParse As Range

    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

    Dim columnLetter As String
    columnLetter = ColumnNumberToLetter(columnToParse)

    Dim result As String
    result = MsgBox("The column you've selected to parse is column " & columnLetter, vbOKCancel)
    If result = vbCancel Then
        MsgBox "Process Cancelled."
    Exit Function
    End If

    lastRow = Cells(Rows.Count, columnToParse.Column).End(xlUp).Row

    Set UserSelectRange = Range(Cells(2, columnToParse.Column), Cells(lastRow, columnToParse.Column))

End Function

Private Function GetUserInputRange() As Range
    'This is segregated because of how excel handles canceling a range input
    Dim userAnswer As Range
    On Error GoTo inputerror
    Set userAnswer = Application.InputBox("Please select a single column to parse", "Column Parser", Type:=8)
    Set GetUserInputRange = userAnswer
    Exit Function
inputerror:
    Set GetUserInputRange = Nothing
End Function


Private Function ColumnNumberToLetter(ByVal selectedRange As Range) As String
    Dim columnLetter As String
    Dim rowBeginningPosition As Long
    rowBeginningPosition = InStr(2, selectedRange.Address, "$")
    columnLetter = Mid(selectedRange.Address, 2, rowBeginningPosition - 2)
    ColumnNumberToLetter = columnLetter
End Function

This isn't posted on the repo yet, just wanted to hit the gauntlet here first.

\$\endgroup\$
  • \$\begingroup\$ One flaw I've recognized is handling errors if the user's input range is not in my expected format. E.g C:C or $C:$C \$\endgroup\$ – Raystafarian Apr 15 '16 at 11:10
  • 2
    \$\begingroup\$ Just a note that I will get around to reviewing this, but I've been a bit swamped so it'll have to wait until next week. \$\endgroup\$ – Kaz Apr 15 '16 at 16:01
3
\$\begingroup\$

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
\$\endgroup\$
  • 1
    \$\begingroup\$ I was running into type mismatch array or user-defined type expected on the If Len(Join( ... line because when I Dim stringParts() as String it needs to be as Variant to be able to be passed as an argument, apparently. \$\endgroup\$ – Raystafarian Apr 15 '16 at 17:08
  • \$\begingroup\$ Or maybe I can just ByRef partsOfString() As String so they are the same type? No, wait, I have to use string or I get a mismatch on stringParts = Split(). Split outputs strings, which a variant should be able to take. Maybe it's because the variant isn't sized? \$\endgroup\$ – Raystafarian Apr 15 '16 at 17:17
  • 2
    \$\begingroup\$ @Raystafarian You can dim an array in 2 ways. Dim array() As Type or Dim array as Variant: array = Array(). You can pass the former to an argument expecting the latter (a variant), but you cannot pass the latter to an argument expecting the former. This is why I stick to declaration #2 for all of my arrays and arguments. \$\endgroup\$ – Kaz Apr 19 '16 at 13:21
  • \$\begingroup\$ @Zak for some reason I was under the impression that I should be giving it a type if I know what type it will be, but I don't remember the reason. So I usually completely avoid variant - correctly or incorrectly. \$\endgroup\$ – Raystafarian Apr 19 '16 at 13:28
  • \$\begingroup\$ Neither way is "correct", both have tradeoffs, but you do have to pick one and stick to it if you want to avoid compile errors. \$\endgroup\$ – Kaz Apr 19 '16 at 13:35
2
\$\begingroup\$

At first, answer of Mat's Mug is great, I agree with it, below you can find additional suggestions:

Readability

Best practice to keep declarations together at the beginning of the sub / function and don't spread it across the code


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

For me the only acceptable use is within On Error GoTo where you can't avoid it. In all other cases it makes the logic of the code difficult to follow.

Performance

stringParts = Split(cellToParse, vbLf)

If you remove consecutive vbLf characters before Split() that makes your later code simpler. For that you can either:

  • use simple loop:

    dim CellContent as String, NewCellContent as String CellContent = CellToParse.Value NewCellContent = (Worksheetfunction.Substitute(CellToParse,vbLf & vbLf,vbLf))
    Do Until CellContent = NewCellContent
    CellContent = NewCellContent NewCellContent = Worksheetfunction.Substitute(NewCellContent,vbLf & vbLf,vbLf)
    Loop StringParts = Split(CellContent,vbLf)

  • use VB regular expression (need to include reference to "Microsoft VBSCript Regular Expression 5.5)


cellToParse.EntireRow.Copy
cellToParse.EntireRow.Insert shift:=xlDown
cellToParse.Offset(-1) = stringParts(i)

Most time consuming parts of VBA macros are generally worksheet manipulation (including read / write, insert / delete ranges...). As your array doesn't contain empty items now, you can get rid of For:

CountSringParts = UBound(StringParts) - LBound(StringParts) + 1  
With cellToParse
    .EntireRow.Copy
    If CountStringParts>1 Then
        .Offset(1,0).Resize(CountStringParts-1,1).EntireRow.Insert 
    End If
    .Resize(CountStringParts,1).Value=StringParts
End With
\$\endgroup\$
  • \$\begingroup\$ All right, I feel kind of dumb about this, but I'm struggling with the "simple loop". newstringparts is long and stringparts() will need to be a variant rather than an array of strings? Or the stringparts should be the celltoparse? \$\endgroup\$ – Raystafarian Apr 20 '16 at 17:26
  • \$\begingroup\$ I've written that too quickly, please see update. \$\endgroup\$ – Máté Juhász Apr 21 '16 at 7:41
  • \$\begingroup\$ Ah ha, that's much more clear and makes more sense, I was trying to do it in the wrong place. \$\endgroup\$ – Raystafarian Apr 21 '16 at 11:39

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.