QuoteSplit challenge

[DigiRev]

I'm tired so this code probably has bugs but I tested it a little. You'll probably find some if you test it.

I'll get back to it later after I get some sleep.

I provided a Start argument so you can choose where to start splitting from and also (hopefully) have the limit part working.

It's probably buggy as hell but here it is:

Option Explicit
 
'Count the number of instances a string appears within another string.
Private Function InStrCount(ByVal Start As Long, ByRef Expression As String, ByRef SearchFor As String, _
    Optional ByRef CompareMethod As VbCompareMethod = vbBinaryCompare) As Long
    
    If Start = 0 Then Exit Function
    If Start > Len(Expression) Then Exit Function
    
    Dim lonPos As Long, lonCount As Long
    
    lonPos = InStr(Start, Expression, SearchFor, CompareMethod)
    
    Do While lonPos > 0
        lonCount = lonCount + 1
        
        lonPos = InStr(lonPos + 1, Expression, SearchFor, CompareMethod)
    Loop
    
    InStrCount = lonCount
    
End Function
 
Public Function QuoteSplit(ByVal Start As Long, ByRef Expression As String, Optional ByRef Delimiter As String = " ", _
    Optional ByVal Limit As Long = -1, Optional ByVal CompareMethod As VbCompareMethod = vbBinaryCompare) As String()
    
    Dim lonLenEXP As Long
    
    lonLenEXP = Len(Expression)
    
    'Quick input checks...
    If lonLenEXP = 0 Then Exit Function     'Expression is empty.
    If Start = 0 Then Exit Function         'Start position is 0.
    If Start > lonLenEXP Then Exit Function 'Start position is greater than length of expression.
    
    Dim strRet() As String 'Return value.
    Dim lonPos As Long 'Position of delimiter.
    Dim lonPrevPos As Long 'Previous position of delimiter.
    Dim lon3Pos As Long 'Previous position of previous delimiter.
    Dim bytInQuote As Byte 'Currently in quotations?
    Dim lonQuoteCount As Long 'Number of quotes found.
    Dim lonCount As Long 'Number of delimiters found (used for Limit argument).
    Dim strTemp As String 'Temp string.
    Dim lonStart As Long 'Temp start position.
    Dim lonEnd As Long 'Temp long position.
    Dim lonLenDelim As Long 'Length of delimiter.
    Dim lonBnd As Long 'UBound of return value.
    Dim strTmpCheck As String
    
    lonLenDelim = Len(Delimiter)
    
    'Find first delimiter.
    lonPos = InStr(Start, Expression, Delimiter, CompareMethod)
    
    'Quick check.
    If lonPos = 0 Then GoTo NoDelimiter
    
    'Keep looping while we can still find the delimiter.
    Do While lonPos > 0
        
        'this,is,"a,test",abc
        
        '  "this,is",a,test
        If lonPrevPos = 0 Then 'This is the first delimiter.
            'Check if we're within quotes.
            strTemp = Mid$(Expression, 1, lonPos - 1)
            
            lonQuoteCount = InStrCount(1, strTemp, Chr$(34), vbBinaryCompare)
            
            If lonQuoteCount Mod 2 = 0 Then
                bytInQuote = 0
            Else
                bytInQuote = 1
            End If
            
            If bytInQuote = 0 Then
                'Not in quotes.
                ReDim strRet(0) As String
                
                strRet(0) = strTemp
                lonPrevPos = lonPos
                
                lonCount = lonCount + 1
                
                'Check if we're done.
                If lonCount = Limit Then
                    QuoteSplit = strRet()
                    
                    Erase strRet()
                    Exit Function
                End If
                
            Else
                lonPos = lonPos + 1
            End If
            
        Else 'This is NOT the first delimiter.
        
            'this,is,"a,test",abc
        
            '  "this,is",a,test
            
            'Get text from previous delimiter to this one.
            lonStart = lonPrevPos + lonLenDelim
            lonEnd = lonPos
            
            
            strTemp = Mid$(Expression, lonStart, lonEnd - lonStart)
            
            'Check if we're inside quotes.
            lonQuoteCount = InStrCount(1, strTemp, Chr$(34), vbBinaryCompare) + CLng(bytInQuote)
            
            If lonQuoteCount Mod 2 = 0 Then
                bytInQuote = 0
            Else
                bytInQuote = 1
            End If
            
            If bytInQuote = 0 Then
                'Not in quotes.
                lonBnd = UBound(strRet()) + 1
                
                ReDim Preserve strRet(0 To lonBnd) As String
                
                strRet(lonBnd) = strTemp
                
                lonCount = lonCount + 1
                lonPrevPos = lonPos
                
                'Check if we're done.
                If lonCount = Limit Then
                    QuoteSplit = strRet()
                    
                    Erase strRet()
                    Exit Function
                End If
                
            Else
                lonPrevPos = lonPrevPos + 1
            End If
        
        End If
        
        lonPos = InStr(lonPos + lonLenDelim, Expression, Delimiter, CompareMethod)
    Loop
    
    'Check for text at end of string.
    If lonPrevPos < lonLenEXP Then
        lonBnd = UBound(strRet()) + 1
        
        ReDim Preserve strRet(0 To lonBnd) As String
        
        strRet(lonBnd) = Mid$(Expression, lonPrevPos + lonLenDelim)
    End If
    
    QuoteSplit = strRet()
    
    Erase strRet()
    
    Exit Function
    
NoDelimiter:
    'Just return the text like the Split() function does.
    ReDim strRet(0) As String
    
    strRet(0) = Expression
    QuoteSplit = strRet()
    
    Erase strRet()
End Function
 
'Test the function.
Private Sub Command1_Click()
    Dim strBuffer() As String
    
    strBuffer() = QuoteSplit(1, Text1.Text, "**")
    
    Dim intLoop As Integer
    
    On Error Resume Next 'For UBound error.
    
    List1.Clear
    
    For intLoop = 0 To UBound(strBuffer())
        List1.AddItem strBuffer(intLoop)
    Next intLoop
    
End Sub