In my DDoE Quick TTC utility, I use two classes; CSplit and CSplits. I really wish I was better at naming classes. But this pair sticks to my usual singular-plural pattern. CSplits is more or less a collection class that holds all of the CSplit instances. I turned out to be more, as I’ll demonstrate.
When I created CSplit, it only had one property: OriginalValue. OriginalValue is the text string to be split. I try very hard to only add properties when the code demands it. It’s so tempting to try to think ahead to all of the properties that the class will need to provide, but it just ends up being sloppy. The logic should determine what the class needs to provide, and I find my classes stay much cleaner when I do it that way. Although I’ll be the first to admit that I don’t follow that 100% of the time.
Other than some overhead, the only other property I added to CSplit was Columns. Columns is a collection that holds the split text. When a CSplit instance is created, and only has an OriginalValue, it also has one Column that’s equal to the OriginalValue.
Public Property Let OriginalValue(ByVal sOriginalValue As String)
msOriginalValue = sOriginalValue
mcolColumns.Add msOriginalValue, "1"
End Property
Whenever OriginalValue is split, I reinitialize the Columns collection. So while my key of “1? looks dangerous, it’s not. That reinitialization looks like this:
Public Sub ResetColumns()
Set mcolColumns = Nothing
Set mcolColumns = New Collection
mcolColumns.Add Me.OriginalValue, "1"
End Sub
Then when I add a column, I pass in the text and the key.
Public Sub AddColumn(ByVal sInput As String, ByVal sUnique As String)
Dim sTextQual As String
Const sSOURCE As String = “AddColumn()”
On Error GoTo ErrorHandler
sTextQual = Me.Parent.TextQualifier
If Len(sTextQual) = 0 Then
mcolColumns.Add sInput, sUnique
Else
If Left$(sInput, 1) = sTextQual And Right$(sInput, 1) = sTextQual Then
mcolColumns.Add Mid$(sInput, 2, Len(sInput) – 2), sUnique
Else
mcolColumns.Add sInput, sUnique
End If
End If
End Sub
I have to strip out the text qualifier if it exists. So if the text qualifier is a double quote, I test for double quotes at the beginning and end of the string and strip them out. “MyFolder” gets stored as MyFolder. That’s pretty much all there is to CSplit. It’s a pretty lightweight class. Most of the work is done in CSplits.
The CSplit.Columns get created when a delimiter is added to the CSplits class. Here’s the code to add a delimiter:
Public Sub AddDelimiter(sDelim As String)
Dim i As Long, j As Long, k As Long
Dim clsSplit As CSplit
Dim sOrig As String
Dim vaTemp As Variant
Dim lDelimCount As Long
Const sSOURCE As String = "AddDelimiter()"
On Error GoTo ErrorHandler
If Len(sDelim) = 0 Then 'AAA
Set mcolDelims = Nothing
Set mcolDelims = New Collection
For i = 1 To mcolSplits.Count
Set clsSplit = mcolSplits.Item(i)
clsSplit.ResetColumns
Next i
Else: 'BBB
On Error Resume Next
mcolDelims.Add sDelim, ConvertStringToCodes(sDelim) 'CCC
On Error GoTo 0
For i = 1 To mcolSplits.Count
Set clsSplit = mcolSplits.Item(i)
'reset Columns
Set clsSplit.Columns = Nothing
Set clsSplit.Columns = New Collection
sOrig = clsSplit.OriginalValue
For j = 1 To mcolDelims.Count
sDelim = mcolDelims.Item(j)
If Me.ConsecutiveDelimiters Then 'DDD
lDelimCount = Len(sOrig) - Len(Replace(sOrig, sDelim, "", , , vbBinaryCompare))
Else
lDelimCount = 1
End If
For k = lDelimCount To 1 Step -1 'EEE
sOrig = Replace(sOrig, RepeatString(k, sDelim), msUNIQUE, , , vbBinaryCompare)
Next k
Next j
vaTemp = Split(sOrig, msUNIQUE)
For j = LBound(vaTemp) To UBound(vaTemp)
clsSplit.AddColumn vaTemp(j), CStr(j)
Next j
Next i
End If
End Sub
AAA: In the first part of the IF statement, I check for a zero-length string. If I send a zero-length string in to the method, it’s my cue to clear out the existing delimiters. A little hokey, I know, but I’ve come to terms with it. BBB: In the ELSE section, I add the delimiter to the collection, split the text, and create Columns in the CSplit class.
CCC: To add the delimiter to the collection I use this technique because I need the keys to be case sensitive. Yes, I know I should use a dictionary object and someday I will. :)
DDD: To handle consecutive delimiters, I have to replace the consecutive ones before the individual ones. In this part of the procedure, I determine how many delimiters there are in the string. If there are five delimiters and the delimiter is a comma, I first look for “,,,,,”, then “,,,,” all the way down to “,”. I know that in most cases I’m not going to have five delimiters in a row, but this method ensures that I get all consecutive delimiters.
EEE: I replace these delimiters with some crazy unique string that nobody will ever in a million years type in the custom delimiter box. I use a RepeatString function instead of the built-in String$ function because my delimiters can be more than one character. String$ only repeats one character. Once I have my crazy unique string in there, I Split on the unique string and add columns to the CSplit class instance.
At first (and still visible in the screen shot below), that crazy unique string consisted of rather normal characters. That seems fine because there’s no way that string will show up. But, and it’s a big but, if I try to delimit on any one of those common characters, it breaks horribly. Now my crazy unique string is something like CHR(240). So if anyone tries to delimit on that it will break. I can live with that for now.
If my OriginalValue is C:\AccIntCalc.xls, you can see below sOrig and the Columns collection of CSplit.
Public Function RepeatString(lNumber As Long, sInput As String) As String
Dim i As Long
Dim sReturn As String
If lNumber > 0 Then
For i = 1 To lNumber
sReturn = sReturn & sInput
Next i
Else
sReturn = sInput
End If
RepeatString = sReturn
End Function
Once I’ve add all my delimiters, all I have to do it iterate through the Columns collection and I have data I need, ready for formatting and output. If you’re following along at home, feel free to download the beta of DDoEQuickTTC.zip
Just a minor note – in the AddDelimiter Sub you use On Error Goto ErrorHandler and On Error Goto 0 – probably need to use one or the other
Charlie
Good one Charlie. I stripped out the error handler for brevity, but I knew I would screw it up.
I have developed a habit of never having On Error Resume Next in a main procedure. I delegate that code off to a separate function, simply
On Error Resume Next
Do its stuff
On Error Goto 0
and call that function from my main procedure. I am jsut paranoid about messing up my error handling :-)