# This macro will convert you… or not

I'm developing a macro that converts a text file, hence the attempt for a funny title, or cringy, opinions may vary!

# Context and Objectives

I was assigned a project to replace a old legacy program whose our contract is about to expire. This program accepted a text file for input and splits it into a new file based on a couple of parameters.

The text file does not have a clear structure, meaning that just separating with spaces, tabs or commas does not produce a clean file with all data.

So the objective of my macro is to input the text file and treat it, and separate it according to a spec, special format for a single case where there's a extra space and normalize it, and finally write to CSV.

As far as speed goes, I am not happy at all with it. It takes about 17 secs to
read, convert and output for a 4MB file
, which has about 24 000 lines.

Probably I am doing some extra code that can be truncated and improved, but I need your wise eyes to help me.

Also, I've already run Rubberduck Build 2.0.11.

The test data and add-in:

There's some really basic error handling in here, I am learning custom error handling now, but I haven't include it here.

Upfront apologies for the length of the post.

# Code

• Outside from any sub, on top

Option Explicit
'@Ignore EncapsulatePublicField, MoveFieldCloserToUsage
Public progressBarCount As Long

• Starting from the main sub that holds all the smaller functions. I've chosen this logic because it runs the procedures in a sequence and doesn't run unnecessary functions.

Public Sub ConvertPanel()

Dim startCell As Range
Dim readMethod As Variant
Dim convertString As Variant
Dim finalProcessor As Variant

Dim specString As String
Dim filePath As String

ExcelOptimization (True)

Set startCell = Worksheets(1).Range(Cells(1, 1), Cells(1, 1))
specString = GetSpecString
filePath = GetFilePath

If ValidateSpecString(specString) Then
If ValidateInputFile(filePath) Then
convertString = ConvertSpecString(specString)
finalProcessor = SplitColumns(readMethod, convertString, startCell)
If finalProcessor Then
If FormatYear Then
If FormatAutocomm Then
If FormatID Then
If FormatHA Then
If FormatProv Then
If ReplaceSpaces Then
If CleanupSpaces Then
If WriteOutputCSV Then
ExcelOptimization (False)
MsgBox "Process completed and file generated!", vbOKOnly, "Complete!"
Exit Sub
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If

End Sub


• Small performance improvement sub

Private Sub ExcelOptimization(ByVal turnState As Boolean)

If turnState Then
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Columns.AutoFit
Else
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ThisWorkbook.Activate
ThisWorkbook.Worksheets(1).Activate
End If

End Sub


• This function defines how the text file should be splitted.

Private Function GetSpecString() As String

Dim customSpecString As Long
customSpecString = MsgBox("Do you want to use default spec string?", vbYesNo + vbQuestion, "Custom spec string")

If customSpecString = vbNo Then
GetSpecString = Application.InputBox("Enter your custom string", "Custom string builder", Type:=2)

If GetSpecString = False Then
MsgBox "No string was chosen. The default string will be used."
GetSpecString = "1,10,@|11,2,@|15,1,@|16,4,@|20,2,@|23,1,@|31,1,@|35,1,@|39,1,@|41,1,@|160,1,@|161,2,@|163,1,@|165,1,@|25,2,@|29,2,@|34,1"
Exit Function
End If
Else
GetSpecString = "1,10,@|11,2,@|15,1,@|16,4,@|20,2,@|23,1,@|31,1,@|35,1,@|39,1,@|41,1,@|160,1,@|161,2,@|163,1,@|165,1,@|25,2,@|29,2,@|34,1"
Exit Function
End If

End Function


• Standard open file from windows explorer

Private Function GetFilePath() As String

Dim choiceNumber As Long

Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
choiceNumber = Application.FileDialog(msoFileDialogOpen).Show

If choiceNumber <> 0 Then
GetFilePath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
Exit Function
Else
MsgBox "No file was chosen. Please re-check!", vbCritical, "Error - no file selected"
GetFilePath = vbNullString
Exit Function
End If

Exit Function

End Function


• Basic validation for split string ( called spec string )

Private Function ValidateSpecString(ByVal specString As String) As Boolean

If Len(specString) < 3 Then
MsgBox "No spec found. Please re-check.", vbCritical, "Error"
ValidateSpecString = False
Exit Function
End If

If specString = vbNullString Then
MsgBox "Field specs are incorrect or missing. Aborting!", vbCritical, "Error"
ValidateSpecString = False
Exit Function
End If

If InStr(specString, "|") = 0 Then
MsgBox "Please specify that you have at least 2 fields. Example: 1,10|2,10"
ValidateSpecString = False
Exit Function
End If

ValidateSpecString = True

End Function


• Basic validation for input file

Private Function ValidateInputFile(ByVal fileName As String) As Boolean

If Dir(fileName, vbNormal) = vbNullString Then
MsgBox "No file found.", vbCritical, "Error"
ValidateInputFile = False
Exit Function
End If

ValidateInputFile = True

End Function


• Function to convert the input spec string to an array to use later

Private Function ConvertSpecString(ByVal specString As String) As String()

Dim fieldsInfo() As String
Dim inputString As String

inputString = Replace(specString, Space(1), vbNullString)
fieldsInfo = Split(inputString, "|")
ConvertSpecString = fieldsInfo

End Function


• Function to read the file that should be quick which I've adapted it from this post

Private Function QuickRead(ByVal fileName As String) As String()

Dim fileNumber As Long
Dim stringRes As String
Dim fileSize As Long

fileNumber = FreeFile
fileSize = FileLen(fileName)
stringRes = Space(fileSize)

Open fileName For Binary Access Read As #fileNumber
Get #fileNumber, , stringRes
Close fileNumber

QuickRead = Split(stringRes, vbCrLf)

End Function


• Main engine of the project, grabs everything from text file and splits into excel spreadsheet from the spec string. You'll notice that there's a special case for a number '822343', which is the only case where there's an extra space that shouldn't be there and thus "fixed" like that. Also I use a class for a progress bar which I only adapted, but the main conception is from Zack Graber.

Private Function SplitColumns(ByVal lineArray As Variant, ByVal fieldsInfo As Variant, ByVal startCell As Range) As Boolean

Dim indexCount As Long
Dim stringRange As Range
Dim fileInfo() As String
Dim counterColumns As Long
Dim counterRows As Long
Dim counterOfElements As Long
Dim numberOfElements As Long
Dim lastRowCounter As Long
'@Ignore SelfAssignedDeclaration
Dim progressBar As New progressBar
Dim convertedString As String

Dim startTime As Double
Dim secondsElapsed As Double
startTime = Timer

Set stringRange = startCell
numberOfElements = 17

counterRows = 1
counterColumns = 1

With ActiveSheet
lastRowCounter = .UsedRange.Rows(.UsedRange.Rows.Count).Row
End With

For indexCount = LBound(lineArray) To UBound(lineArray)

For counterOfElements = 0 To numberOfElements - 1

If Left$(lineArray(indexCount), 6) = "822343" Then convertedString = Left$(lineArray(indexCount), 37) & Mid$(lineArray(indexCount), 39, Len(lineArray(indexCount)) + 1) fileInfo = Split(fieldsInfo(counterOfElements), ",") stringRange.EntireRow.Cells(counterRows, counterColumns).Value = Mid$(convertedString, CLng(fileInfo(0)), CLng(fileInfo(1)))
counterColumns = counterColumns + 1

Else

fileInfo = Split(fieldsInfo(counterOfElements), ",")
stringRange.EntireRow.Cells(counterRows, counterColumns).Value = Mid$(lineArray(indexCount), CLng(fileInfo(0)), CLng(fileInfo(1))) counterColumns = counterColumns + 1 End If Next counterOfElements counterColumns = 1 counterRows = counterRows + 1 If UBound(lineArray) < 100 Then If UBound(lineArray) = 1 Then progressBarCount = 100 Else progressBarCount = (counterRows * 100) / lastRowCounter End If Else progressBarCount = (counterRows * 100) / UBound(lineArray) End If If UBound(lineArray) = 0 Then progressBarCount = 0 End If progressBar.Update progressBarCount, 100, "Processing records", True Next indexCount SplitColumns = True secondsElapsed = Round(Timer - startTime, 2) MsgBox "Macro run in " & secondsElapsed & " seconds." End Function  • For the next couple of functions, I just format specific fields that are needed for our database system (please let me know if I should remove these). Private Function FormatYear() As Boolean Dim maxRowNumber As Long Dim rowNumber As Long On Error GoTo FormatYearErrHandler maxRowNumber = (Cells(Rows.Count, 3).End(xlUp).Row) For rowNumber = 1 To maxRowNumber Cells(rowNumber, 4).Value = Cells(rowNumber, 4).Value & Format$(Cells(rowNumber, 5).Value, "00")
Next rowNumber
Columns(5).EntireColumn.Delete
FormatYear = True
Exit Function

FormatYearErrHandler:
FormatYear = False
Exit Function

End Function


Private Function FormatAutocomm() As Boolean

Dim maxRowNumber As Long
Dim rowNumber    As Long
Dim valueString As String

On Error GoTo FormatAutocommErrHandler
ThisWorkbook.Worksheets(1).Activate
maxRowNumber = Cells(Rows.Count, 11).End(xlUp).Row

For rowNumber = 1 To maxRowNumber
valueString = Format$(Cells(rowNumber, 11).Value, "00") Cells(rowNumber, 11).NumberFormat = "@" Cells(rowNumber, 11).Value = valueString valueString = vbNullString Next rowNumber FormatAutocomm = True Exit Function FormatAutocommErrHandler: FormatAutocomm = False Exit Function End Function  Private Function FormatID() As Boolean Dim maxRowNumber As Long Dim rowNumber As Long On Error GoTo FormatIDErrHandler maxRowNumber = (Cells(Rows.Count, 1).End(xlUp).Row) For rowNumber = 1 To maxRowNumber Cells(rowNumber, 1).Value = Cells(rowNumber, 1) * 1 Next rowNumber FormatID = True Exit Function FormatIDErrHandler: FormatID = False Exit Function End Function  Private Function FormatHA() As Boolean Dim maxRowNumber As Long Dim rowNumber As Long Dim valueString As String On Error GoTo FormatAutocommErrHandler ThisWorkbook.Worksheets(1).Activate maxRowNumber = Cells(Rows.Count, 14).End(xlUp).Row For rowNumber = 1 To maxRowNumber valueString = Format$(Cells(rowNumber, 14).Value, "00")
Cells(rowNumber, 14).NumberFormat = "@"
Cells(rowNumber, 14).Value = valueString
valueString = vbNullString
Next rowNumber

FormatHA = True
Exit Function

FormatAutocommErrHandler:
FormatHA = False
Exit Function

End Function


Private Function FormatProv() As Boolean

Dim maxRowNumber As Long
Dim rowNumber    As Long
Dim valueString As String

On Error GoTo FormatAutocommErrHandler
ThisWorkbook.Worksheets(1).Activate
maxRowNumber = Cells(Rows.Count, 15).End(xlUp).Row

For rowNumber = 1 To maxRowNumber
valueString = Format$(Cells(rowNumber, 15).Value, "00") Cells(rowNumber, 15).NumberFormat = "@" Cells(rowNumber, 15).Value = valueString valueString = vbNullString Next rowNumber FormatProv = True Exit Function FormatAutocommErrHandler: FormatProv = False Exit Function End Function  • Adding some headers Private Function AddHeader() As Boolean Dim arr(1 To 16) As String On Error GoTo AddHeaderErrHandler arr(1) = "a" arr(2) = "b" arr(3) = "c" arr(4) = "d" arr(5) = "f" arr(6) = "g" arr(7) = "h" arr(8) = "i" arr(9) = "j" arr(10) = "k" arr(11) = "l" arr(12) = "m" arr(13) = "n" arr(14) = "o" arr(15) = "p" arr(16) = "q" With Worksheets(1) .Range("A1").EntireRow.Insert .Range("A1:P1") = arr() End With AddHeader = True Exit Function AddHeaderErrHandler: AddHeader = False Exit Function End Function  • Cleaning up data for sparse spaces Private Function ReplaceSpaces() As Boolean Dim MyArray As Variant Dim rowCountArray As Long, columnCountArray As Long MyArray = ActiveSheet.UsedRange For rowCountArray = LBound(MyArray) To UBound(MyArray) For columnCountArray = LBound(MyArray, 2) To UBound(MyArray, 2) If MyArray(rowCountArray, columnCountArray) <> vbNullString Then If InStr(1, MyArray(rowCountArray, columnCountArray), " ") > 0 Then Cells(rowCountArray, columnCountArray).Value = WorksheetFunction.Substitute(MyArray(rowCountArray, columnCountArray), " ", "0") End If End If Next columnCountArray Next rowCountArray ReplaceSpaces = True End Function  • Cleaning up data after used range, to prevent when writing csv to show up blanks Private Function CleanupSpaces() As Boolean Dim fileWorksheet As Worksheet Dim lastRow As Long Dim lastColumn As Long Dim usedRows As Long Dim usedColumns As Long Set fileWorksheet = ActiveSheet With fileWorksheet lastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row lastColumn = .UsedRange.Columns(.UsedRange.Columns.Count).Column usedRows = .UsedRange.Row + .UsedRange.Rows.Count - 1 usedColumns = .UsedRange.Column + .UsedRange.Columns.Count - 1 .Range(.Cells(lastRow, lastColumn + 1), .Cells(lastRow + usedRows, lastColumn + usedColumns + 1)).Clear End With CleanupSpaces = True End Function  • Finally, generating CSV file Private Function WriteOutputCSV() As Boolean Dim fileName As String Dim fileDelimiter As String Dim fileString As String Dim fileLastRow As Long Dim fileLastCol As Long Dim counterRow As Long Dim counterCol As Long Dim binaryStream As ADODB.Stream Dim fileWorksheet As Worksheet Const adSaveCreateOverWrite As Variant = 2 Set fileWorksheet = ActiveSheet Set binaryStream = New ADODB.Stream fileName = Application.GetSaveAsFilename(vbNullString, "CSV File (*.csv), *.csv") fileDelimiter = ";" counterRow = 1 counterCol = 1 binaryStream.Charset = "UTF-8" binaryStream.Type = 2 binaryStream.Open With fileWorksheet fileLastRow = .Range("A" & .Rows.Count).End(xlUp).Row fileLastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column End With Do Until counterRow = fileLastRow + 1 Do Until counterCol = fileLastCol + 1 fileString = fileString & Chr$(34) & fileWorksheet.Cells(counterRow, counterCol).Value & Chr\$(34)
If counterCol <> fileLastCol Then
fileString = fileString & fileDelimiter
End If
counterCol = counterCol + 1
Loop
binaryStream.WriteText fileString, 1
counterRow = counterRow + 1
counterCol = 1
fileString = vbNullString
Loop

binaryStream.Close
MsgBox "CSV generated successfully"
WriteOutputCSV = True
Sheets(fileWorksheet.Name).UsedRange.Delete

End Function

• Seems progressBarCount could be local to ConvertPanel and a parameter to SplitColumns... is it used in another module? Because from the posted code I'm not sure what warrants '@Ignore MoveFieldCloserToUsage, which seems a correct suggestion from Rubberduck. – Mathieu Guindon May 23 '17 at 14:24
• Hi @Mat'sMug! Yes it used in a separate class – svacx May 23 '17 at 14:28

Just a small note about the elephant in the room:

        If finalProcessor Then
If FormatYear Then
If FormatAutocomm Then
If FormatID Then
If FormatHA Then
If FormatProv Then
If ReplaceSpaces Then
If CleanupSpaces Then
If WriteOutputCSV Then


Each and every single one of these Boolean-returning functions should be a Sub: they all have side-effects on the data, and if one of them fails, everything needs to abort.

This looks like a job for... custom error handling! That way you can flatten up that smelly arrow code and turn it into a sequence of operations:

    On Error GoTo ErrHandler

'...

finalProcessor
FormatYear
FormatAutocomm
FormatID
FormatHA
FormatProv
ReplaceSpaces
CleanupSpaces

'temporal coupling: everything above must run before this one
WriteOutputCSV

'...
Exit Sub
ErrHandler:
MsgBox Err.Description, vbExclamation


You can have each of these functions either bubble up any run-time error that occurs, or raise custom ones with a descriptive message that the "coordinator" procedure displays before exiting.

For example:

Private Sub ValidateSpecString(ByVal specString As String)

If Len(specString) < 3 Then
Err.Raise ERR_INVALID_SPEC, "ValidateSpecString", "No spec found. Please re-check."
End If

If specString = vbNullString Then
Err.Raise ERR_INVALID_SPEC, "ValidateSpecString", "Field specs are incorrect or missing. Aborting!"
End If

If InStr(specString, "|") = 0 Then
Err.Raise ERR_INVALID_SPEC, "ValidateSpecString", "Please specify that you have at least 2 fields. Example: 1,10|2,10"
End If

End Function


This has the added benefit of moving the concern of telling the user why the macro is failing in one single place, so you have one single error-displaying MsgBox instead of 12 (and one single "success" message).

• Thank you so much, I'm actually learning how to custom error, and that actually helps me so much! – svacx May 23 '17 at 14:52

To take a stab at the arrow issue, an alternative would be something similar to:

    If Not ValidateSpecString(specString) Then HandleError (CustomErrorInfo)
If Not ValidateInputFile(filePath) Then HandleError (CustomErrorInfo)

convertString = ConvertSpecString(specString)
finalProcessor = SplitColumns(readMethod, convertString, startCell)

If Not finalProcessor Then HandleError (CustomErrorInfo)
If Not FormatYear Then HandleError (CustomErrorInfo)
If Not FormatAutocomm Then HandleError (CustomErrorInfo)
If Not FormatID Then HandleError (CustomErrorInfo)
If Not FormatHA Then HandleError (CustomErrorInfo)
If Not FormatProv Then HandleError (CustomErrorInfo)
If Not ReplaceSpaces Then HandleError (CustomErrorInfo)
If Not CleanupSpaces Then HandleError (CustomErrorInfo)
If Not WriteOutputCSV Then HandleError (CustomErrorInfo)

ExcelOptimization (False)

MsgBox "Process completed and file generated!", vbOKOnly, "Complete!"


Admittedly, this is uglier than Mat's Mug's approach, but this is the approach I use because it suits my style and needs a bit more. The benefit here is that you can choose your approach to handling the error. So, for example, handling an error in the FormatYear routine can be different than handling an error in the FormatID routine. I also avoid On Error statements as much as a possibly can. There isn't anything wrong with them when used well, but I try to anticipate errors if I can.

On that note, and as others have noted, some of your subroutines need some cleanup. Someone in the RD group recently reminded me of the 'Single Responsibility Principle'. Everything should be responsible for one thing, and in turn, that thing should align with it's own intent. Along these lines, I would argue, that one unique thing should only ever be returned by one owner of sorts. For example:

Private Function GetSpecString() As String

Dim customSpecString As Long
customSpecString = MsgBox("Do you want to use default spec string?", vbYesNo + vbQuestion, "Custom spec string")

If customSpecString = vbNo Then
GetSpecString = Application.InputBox("Enter your custom string", "Custom string builder", Type:=2)

If GetSpecString = False Then
MsgBox "No string was chosen. The default string will be used."
GetSpecString = "1,10,@|11,2,@|15,1,@|16,4,@|20,2,@|23,1,@|31,1,@|35,1,@|39,1,@|41,1,@|160,1,@|161,2,@|163,1,@|165,1,@|25,2,@|29,2,@|34,1"
Exit Function
End If
Else
GetSpecString = "1,10,@|11,2,@|15,1,@|16,4,@|20,2,@|23,1,@|31,1,@|35,1,@|39,1,@|41,1,@|160,1,@|161,2,@|163,1,@|165,1,@|25,3,@|29,2,@|34,1"
Exit Function
End If

End Function


Can you find the one difference I made between the first GetSpecString and the second? How long did it take you to find it? This was done to prove a point of course, but imagine if you, in all your wisdow, edited the first spec string, but forgot to make the same change to the second. Now you have two possible 'routes' your code can take, and it will take you forever to figure out why. Something like:

Function DefaultSpecString() as String
DefaultSpecString = "1,10,@|11,2,@|15,1,@|16,4,@|20,2,@|23,1,@|31,1,@|35,1,@|39,1,@|41,1,@|160,1,@|161,2,@|163,1,@|165,1,@|25,2,@|29,2,@|34,1"
End Function


And you can use it like this:

Private Function GetSpecString() As String
Dim customSpecString As Long
customSpecString = MsgBox("Do you want to use default spec string?", vbYesNo + vbQuestion, "Custom spec string")

If customSpecString = vbNo Then
GetSpecString = Application.InputBox("Enter your custom string", "Custom string builder", Type:=2)

' Note : A string shouldn't be a boolean False. Check this and find a better way of determining
' whether the user input a valid string. Keeping it as is for proof of concept though.
If GetSpecString <> False Then Exit Function
End If

GetSpecString = DefaultSpecString
End Function


Notice how I ensure that only one line has responsibility over setting the return of the function to the default string. If the user chooses not to enter a custom string, then the function skips the If block and sets the string. If the user enters an invalid string it ignores the If ... Exit Function and again sets it to the default string.

Always try to strive for this. It will make your debugging that much easier. Otherwise, if you do the same thing in two places, and it breaks, you have to fix it in two places. I can't tell you how many hours that has cost me before I learned to code smarter.

Finally, my last note is this, and it is somewhat counter intuitive to my first suggestion: if you are relying on Boolean returns, and "On Error" statements to catch errors, you can improve. Look at why it breaks, and then try to handle that specific issue. As Mat's Mug mentioned, bubble it up if you can.

In my most recent project I am aggregating a fairly complex report, and if even one of the sub reports fails it could invalidate the data. Instead of checking for errors at every juncture, I let the functions return empty arrays if they fail, otherwise they return the data they were supposed to. In my aggregation routine, I check to see if there is data in the input, and if not I handle it appropriately. I also alert the user to what data is missing, and where I am trying to use it. As a result, the routine fails productively, and I can then trace it back down to determine what went wrong.

Overall though, 17 seconds for a routine to run isn't too bad. Youre likely taking the biggest performance hit on the fileread, and on the formatting on the worksheet (any time you perform operations on the worksheet it will cost you more than it would if you did it in memory).

• thank you so much for the great review! The observation about the default string is really clever and I'll implement it! Great job :) – svacx May 29 '17 at 15:58

Just as an alternative to @MatsMug 's excellent suggestion on custom error handling, in cases where I've needed to combine a large number of Boolean flags to determine if processing can continue, I've used the multiplicative property of Boolean values to make it easier to read. As an example, your nested logic would become:

Dim everythingsGood as Boolean
everythingsGood = finalProcessor * FormatYear * _
FormatAutocomm * FormatID * _
FormatHA * FormatProv * AddHeader * _
ReplaceSpaces * CleanupSpaces

If everythingsGood Then
WriteOutputCSV
End If


This method also benefits from @MatsMug 's custom error handling, as above. In the above case, the lack of an error by default passes processing to the next stage. For a set of Boolean-returning functions, this everythingsGood flag is arguably unnecessary.

• Would it be bettor to use And instead? Is there a benefit of using * instead that I'm unaware of? – IvenBach May 23 '17 at 15:54
• @IvenBach - False = 0, True <> 0 so by multiplying, you end up with a 0 if any one function returns False. Actually, quite clever and I'd never thought of that... Unfortunately, because VBA doesn't shortcut evaluation in any way it appears that all the functions must run in this method before everythingGood is set and can be checked, instead of stopping on the first failure. That could be good or bad, depending on how you want/handle error reporting - stop & report the first error, or attempt all processing & report all errors. – FreeMan May 23 '17 at 17:54
• That's what I thought. I'll err on the side of caution and stick with And boolean operator and not go with clever code. I've been bitten too many times doing that. Duly noted about the full evaluation of everything. – IvenBach May 23 '17 at 20:57
• The only real downside to the multiplicative property in this case is that all evaluations have to run before the final evaluation can be made. For a 17 second routine it is negligible, but if you were to use this approach on a larger routine it could cost you in the long run. Additionally, if you do something like a * b * c, but c is dependant on b, you will encounter two errors (the initial error in b and the error in c when it can't get what it needs from b). – Brandon Barney May 25 '17 at 18:06