# A Moses's worthy string splitter

I am trying to perfect my string splitter's performance, to be more fast, more easy to maintain if someone else reads it and more readable code-wise.

# Context ,Scope and Objectives

Where I work we use a sort of "configuration files" to calculate some data warehouse databases.

For example, if you wanted to config a file to calculate the number of supermarkets in a country, the config file would like the below example, where the: first line is the description/name of the store and the line below is the code for the program to pick up (where 50 = S is the category for the sales, 97 = 01 is the "I've bought it myself" and 183 is the column where the code for the store is stored (in this case 0040).

Store1
50=S+97=01+183=0040


So the codes for the configuration are mostly the same across all variables, but it always end with an equal sign. It happens that when a store has more than 10 codes we have to split them manually, it results in a quite of work.

My ultimate goal for this string splitter is for it to be : fast, reliable, easy to maintain /understand and user friendly.

Being unexperienced with programming, I still have issues using the proper naming conventions. I have been studying the VBA Developers Handbook by Ken Getz and I didn't quite understand the conventions.

Also I feel that I am using a shotgun to kill a ant (apologies for the cringy metaphor).

# Code & Logic

• I've started with a main object where I store the general procedures to make/call:

Option Explicit

Private Sub SplitCodes()

Dim inputRange As Range
Dim currentSheetIndex As Long

currentSheetIndex = ActiveSheet.Index
Set inputRange = Application.InputBox("Select single cell.", "Selection", Type:=8)

ExcelOptimization (True)

If ValidateData(inputRange, currentSheetIndex) = True Then
If RunSplitter(inputRange, currentSheetIndex) = True Then
If RemoveCommas(inputRange, currentSheetIndex) = True Then
MsgBox "Splitter run sucessfully", vbOKOnly, "Splitter"
Else
End If
End If
End If
ExcelOptimization (False)

End Sub


• Then I created an procedure to optimize simple excel stuff like the ScreenUpdating:

Private Sub ExcelOptimization(ByVal turnState As Boolean)

If turnState = False Then
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Else
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
End If

End Sub


• Then I've managed to write a validation procedure to check whether the list is missing a code/description, by checking if the rows are pair, and to check if the second item has a code like value (50=S+97=01+183=XXXX):

Private Function ValidateData(ByVal inputRange As Variant, ByVal activeSheetIndex As Long) As Boolean

Dim errorMessage As String, stringToFind As String
Dim countRows As Long, countArray As Long
Dim stringPosition As Long, stringCharacterCount As Long
Dim delimiterArray() As String

On Error GoTo ErrorHandler

countRows = Sheets(activeSheetIndex).Range(inputRange, inputRange.End(xlDown)).Rows.Count
stringToFind = "=|#"
delimiterArray = Split(stringToFind, "|")

If countRows Mod 2 = 0 Then

If Len(inputRange) > 0 Then

For countArray = LBound(delimiterArray) To UBound(delimiterArray)
stringPosition = 1
stringToFind = delimiterArray(countArray)
Do
stringPosition = InStr(stringPosition, inputRange, stringToFind, vbBinaryCompare)
If stringPosition > 0 Then
stringCharacterCount = stringCharacterCount + 1
stringPosition = stringPosition + Len(stringToFind)
End If
Loop While stringPosition > 0
Next countArray

If stringCharacterCount > 0 Then
ValidateData = False
Exit Function
Else
ValidateData = True
End If
End If

Else
MsgBox "Range is uneven. Please recheck.", vbCritical, "Error found!"
Exit Function
End If

ErrorHandler:

If Err.Number <> 0 Then

errorMessage = "Error #" & Str$(Err.Number) & " was generated by " & Err.Source & "." & Chr$(10) & "Error description: " & Err.Description
MsgBox errorMessage, , "Error", Err.HelpFile, Err.HelpContext
Exit Function
End If

End Function


• This is the function that does most of the work, where it splits everything with > 8 links/codes:

Private Function RunSplitter(ByVal inputRange As Variant, ByVal activeSheetIndex As Long) As Boolean

Dim errorMessage As String, stringToFind As String, codeString As String, arrayString As String, codeBuilderString As String
Dim countRows As Long, countArray As Long, counterCodeArray As Long, counterRow As Long
Dim stringPosition As Long, stringCharacterCount As Long, stringLastPosition As Long
Dim delimiterArray() As String, codeArray() As String
Dim isUBound As Boolean, isEndOfArray As Boolean

On Error GoTo ErrorHandler
RunSplitter = False
codeBuilderString = CodeStringBuilder(inputRange)
countRows = Sheets(activeSheetIndex).Range(inputRange, inputRange.End(xlDown)).Rows.Count
stringToFind = "=|#"
delimiterArray = Split(stringToFind, "|")
isUBound = False
isEndOfArray = False

For counterRow = inputRange.Row To countRows
If Len(ActiveSheet.Cells(counterRow, inputRange.Column)) > 0 Then
For countArray = LBound(delimiterArray) To UBound(delimiterArray)
stringLastPosition = 0
stringPosition = 1
stringToFind = delimiterArray(countArray)

Do
stringPosition = InStr(stringPosition, ActiveSheet.Cells(counterRow, inputRange.Column), stringToFind, vbBinaryCompare)
If stringPosition > 0 Then
stringCharacterCount = stringCharacterCount + 1
stringPosition = stringPosition + Len(stringToFind)
stringLastPosition = stringPosition
End If
Loop While stringPosition > 0

If stringLastPosition > 0 Then
codeString = Mid$(ActiveSheet.Cells(counterRow, inputRange.Column), stringLastPosition, Len(ActiveSheet.Cells(counterRow, inputRange.Column))) codeArray = Split(codeString, ",") If UBound(codeArray) > 9 Then arrayString = vbNullString For counterCodeArray = LBound(codeArray) To UBound(codeArray) isUBound = (counterCodeArray = UBound(codeArray)) If counterCodeArray > 8 Then If (counterCodeArray Mod 9 = 0) Then isEndOfArray = True arrayString = vbNullString ActiveSheet.Cells(counterRow + 1, inputRange.Column).Insert ActiveSheet.Cells(counterRow + 2, inputRange.Column).Insert ActiveSheet.Cells(counterRow + 1, inputRange.Column).NumberFormat = "@" ActiveSheet.Cells(counterRow + 2, inputRange.Column).NumberFormat = "@" ActiveSheet.Cells(counterRow + 1, inputRange.Column).Value = ActiveSheet.Cells(counterRow - 1, inputRange.Column).Value arrayString = arrayString + codeArray(counterCodeArray) + "," ActiveSheet.Cells(counterRow + 2, inputRange.Column).Value = codeBuilderString + arrayString If isUBound = True Then arrayString = arrayString + codeArray(counterCodeArray) End If Else If isEndOfArray = True Then arrayString = arrayString + codeArray(counterCodeArray) + "," ActiveSheet.Cells(counterRow + 2, inputRange.Column).Value = codeBuilderString + arrayString Else arrayString = arrayString + codeArray(counterCodeArray) + "," ActiveSheet.Cells(counterRow, inputRange.Column).Value = codeBuilderString + arrayString End If End If Else arrayString = arrayString + codeArray(counterCodeArray) + "," ActiveSheet.Cells(counterRow, inputRange.Column).Value = codeBuilderString + arrayString End If Next counterCodeArray End If End If isUBound = False isEndOfArray = False Next countArray End If Next counterRow RunSplitter = True ErrorHandler: If Err.Number <> 0 Then errorMessage = "Error #" & Str$(Err.Number) & " was generated by " & Err.Source & "." & Chr$(10) & "Error description: " & Err.Description MsgBox errorMessage, , "Error", Err.HelpFile, Err.HelpContext Exit Function End If End Function  • The way the code is setup, when it splits it creates a comma at the end of split, so this removes them: Private Function RemoveCommas(ByVal inputRange As Variant, ByVal activeSheetIndex As Long) As Boolean Dim errorMessage As String Dim countRows As Long, counterRow As Long, lengthString As Long On Error GoTo ErrorHandler countRows = Sheets(activeSheetIndex).Range(inputRange, inputRange.End(xlDown)).Rows.Count For counterRow = inputRange.Row To countRows If Right$(ActiveSheet.Cells(counterRow, inputRange.Column).Value, 1) = "," Then
lengthString = Len(ActiveSheet.Cells(counterRow, inputRange.Column))
ActiveSheet.Cells(counterRow, inputRange.Column).NumberFormat = "@"
ActiveSheet.Cells(counterRow, inputRange.Column).Value = Left$(ActiveSheet.Cells(counterRow, inputRange.Column), lengthString - 1) End If Next counterRow RemoveCommas = True ErrorHandler: If Err.Number <> 0 Then errorMessage = "Error #" & Str$(Err.Number) & " was generated by " & Err.Source & "." & Chr$(10) & "Error description: " & Err.Description MsgBox errorMessage, , "Error", Err.HelpFile, Err.HelpContext Exit Function End If End Function  • This function creates the "50=S+97...." part and addes it to the codes: Private Function CodeStringBuilder(ByVal inputRange As Variant) As String Dim errorMessage As String, codeString As String Dim lengthString As Long, stringPosition As Long, stringLastPosition As Long On Error GoTo ErrorHandler stringPosition = 1 stringLastPosition = 0 Do stringPosition = InStr(stringPosition, ActiveSheet.Cells(inputRange.Row + 1, inputRange.Column), "=", vbBinaryCompare) If stringPosition > 0 Then stringPosition = stringPosition + 1 stringLastPosition = stringPosition End If Loop While stringPosition > 0 lengthString = Len(ActiveSheet.Cells(inputRange.Row + 1, inputRange.Column)) - stringLastPosition + 1 lengthString = Len(ActiveSheet.Cells(inputRange.Row + 1, inputRange.Column)) - lengthString codeString = Left$(ActiveSheet.Cells(inputRange.Row + 1, inputRange.Column), lengthString)

CodeStringBuilder = codeString

ErrorHandler:

If Err.Number <> 0 Then

errorMessage = "Error #" & Str$(Err.Number) & " was generated by " & Err.Source & "." & Chr$(10) & "Error description: " & Err.Description
MsgBox errorMessage, , "Error", Err.HelpFile, Err.HelpContext
Exit Function
End If

End Function


I've added a test set of data to use and the results I get. It can be found at this pastebin link

Important note: I've run the rubber duck on this version and updated the code! Also, thanks for reviewing a very long code post!

• Rubberduck 2.0.11 inspections will pop results for multiple declarations in the same instruction at several places, unqualified Sheets and Cells calls implicitly referring to the active worksheet, use of variant-returning string functions instead of the string-returning equivalents (e.g. Right instead of Right\$); v2.0.12 (not released yet) is also going to complain about some Hungarian Notation with a few identifier names (e.g. intRow), and ..I haven't run it either, so there might be some unused locals too. Kudos for mentioning Rubberduck! Why not run inspections before CR? – Mathieu Guindon Jan 16 '17 at 16:42
• Note: Running RD is not required for a post on CR. However, it certainly will help you fix some issues so we don't have to comment on them. – user34073 Jan 16 '17 at 16:43
• The fourth bullet point - does the function have a name? Or input? What does it return? I assume it's Function RunSplitter() As Boolean but does it have arguments? – Raystafarian Jan 20 '17 at 16:48
• Maybe it's Function RunSplitter(ByVal inputrange As Range, ByVal activesheetindex As Long) As Boolean? – Raystafarian Jan 20 '17 at 16:54
• @Raystafarian sorry it was a edit issue! should look better now – svacxpython Jan 20 '17 at 17:09

### Boolean

This can be simplified, if you check a boolean, you don't need to check its value

Private Sub ExcelOptimization(ByVal turnState As Boolean)

If turnState = False Then
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Else
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
End If

End Sub


If Not turnState then


or swap it

If turnState then


Personally, I would use turnState = true for turning screenupdating and enableevents to true, so it's less confusing:

If turnState Then
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Else
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
End If


And swap your calls in SplitCodes

In SplitCodes you do it again

If ValidateData(inputRange, currentSheetIndex) Then
If RunSplitter(inputRange, currentSheetIndex) Then
If RemoveCommas(inputRange, currentSheetIndex) Then


I like the nesting instead of using an If AND AND because you won't run functions unnecessarily.

### Cancel input

You aren't handling a cancel event for

Set inputRange = Application.InputBox("Select single cell.", "Selection", Type:=8)


### Function calls

It is excellent you're passing everything ByVal. However, I see the main sub is Private - how is it called?

### Variable declaration

I see no added value in declaring variables on the same line like this-

Dim errorMessage As String, stringToFind As String
Dim countRows As Long, countArray As Long
Dim stringPosition As Long, stringCharacterCount As Long
Dim delimiterArray() As String


Additionally, something like countArray I would expect to be an array. And it seems you could use a constant for your string finding:

Const STRING_TO_FIND As String = "=|#"
Const DELIMITER As String = "|"
Dim errorMessage As String
Dim rowCount As Long
Dim arrayIndex As Long
Dim stringPosition As Long
Dim characterCount As Long
Dim delimiterArray() As String


You'll see by putting the constants at the top, you can change them once without needing to find them everywhere in the code.

### LastRow

I think you're trying to get the last row here

countRows = Sheets(activesheetindex).Range(inputRange, inputRange.End(xlDown)).Rows.Count


There is a standard way to find lastRow and lastColumn. That post explains why.

### Error handling

Looks like you have the same error handler everywhere, perhaps just declare it in the main sub and use error handling in each function to return a value that will trigger the error handler. Much better than repeating it a lot.

arrayString = vbNullString


awesome use of vbNullString - it's something a lot of people miss.

### Function or Sub

You have a function here to return a boolean, but you also have things happening in the function. Functions should be used when something is returned and subs should be used when something happens. You can probably refactor that into several procedures. The same might be applicable for other functions.

### ActiveSheet

Try to avoid things like activesheet and select - it's unclear. Since you're already finding the Sheet Index, you can create a worksheet variable for whatever worksheet you're on and use that instead of activesheet. It goes along with the comments of unqualified arguments.

### On Error GoTo

What could go wrong?

I know it's pretty tempting to use the GoTo, but if you can, try to handle the error instead of waiting for the error. Anticipate what could error and find a way around the error. For instance:

countRows = Sheets(activesheetindex).Range(inputRange, inputRange.End(xlDown)).Rows.Count


What if this returns 0? Will other errors occur down the line? Why not handle it there

If countRows = 0 then GoTo ErrorHandler


But, instead of the goto, you can raise the Err and surround it in an If to pass it down to the handler. Or, create your own custom errors - which I think is probably beyond you right now, it's nearly beyond me, but I've done it.

### Counting

This here -

stringCharacterCount = stringCharacterCount + 1
stringPosition = stringPosition + Len(stringToFind)
stringLastPosition = stringPosition


You don't reuse stringPosition before finding it again, so

stringLastPosition = 1
stringPosition = 1
stringToFind = delimiterArray(countArray)
Do
stringPosition = InStr(stringLastPosition, ActiveSheet.Cells(counterRow, inputRange.Column), stringToFind, vbBinaryCompare)
If stringPosition > 0 Then
stringLastPosition = stringPosition + Len(stringToFind)
stringCharacterCount = stringCharacterCount + 1
End If
Loop While stringPosition > 0

• Thank you for the 5* review! I will learn the custom errors, as I am very curious about it! Any good source you could provide? – svacxpython Jan 20 '17 at 17:46
• I'd start here where I used it and got a lot of good feedback. Which started here. Be sure to correct some things and repost it for more review, I definitely didn't cover everything. – Raystafarian Jan 20 '17 at 17:56