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) <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
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.