How to split a string every fourth delimiter? - vba

Question

Is it possible to split a string every fourth delimiter?
We receive a text file that has one string containing several days data.
I would like to split once using the '|' as the delimiter, but different days data is joined by a comma.
Option Explicit
Sub Split4thdelim()
Dim strOriginal as string
Dim originalArry() as string
Dim X as long
strOriginal = "01/01/2020|user1,89|user2,90|user3,99,02/01/2020|user1,80|user2,85|user3,97,03/01/2020|user1,88|user2,96|user3,99"
originalArry = split(strOriginal,"|")
For X = originalArry(originalArry(Lbound)) to originalArry(originalArry(Ubound))
Debug.Print originalArry(X)
Next
End Sub
I would like to split it like this:
01/01/2020
user1,89
user2,90
user3,99
02/01/2020
user1,80
user2,85
user3,97
03/01/2020
user1,88
user2,96
user3,99

Answer 1

Sub Split4thdelim()
Dim strOriginal As String
Dim originalArry() As String
Dim X As Long, n As Long
strOriginal = "01/01/2020|user1,89|user2,90|user3,99,02/01/2020|user1," & _
"80|user2,85|user3,97,03/01/2020|user1,88|user2,96|user3,99"
'replace every fourth "," with chr(0)
For X = 1 To Len(strOriginal)
If Mid(strOriginal, X, 1) = "," Then
n = n + 1
If n Mod 4 = 0 Then Mid(strOriginal, X, 1) = Chr(0)
End If
Next X
originalArry = Split(strOriginal, Chr(0))
For X = LBound(originalArry) To UBound(originalArry)
Debug.Print Join(Split(originalArry(X), "|"), vbLf)
Next
End Sub

Answer 2

Do it manually:
Sub Split4thdelim()
Dim strOriginal As String
Dim Token As New Collection
Dim strToken As String
Dim X As Long
strOriginal = "01/01/2020|user1,89|user2,90|user3,99,02/01/2020|user1,80|user2,85|user3,97,03/01/2020|user1,88|user2,96|user3,99"
Dim Pos As Long
Dim strTemp As String
Pos = InStr(1, strOriginal, "user")
Token.Add Mid(strOriginal, 1, Pos - 2)
strOriginal = Right(strOriginal, Len(strOriginal) - Pos + 1)
While Pos > 0
Pos = InStr(2, strOriginal, "user")
Token.Add Mid(strOriginal, 1, Pos - 2)
strOriginal = Right(strOriginal, Len(strOriginal) - Pos + 1)
Pos = InStr(2, strOriginal, "user")
Token.Add Mid(strOriginal, 1, Pos - 2)
strOriginal = Right(strOriginal, Len(strOriginal) - Pos + 1)
Pos = InStr(2, strOriginal, "user")
If Pos = 0 Then 'no more user, so this is the last set
Token.Add Right(strOriginal, Len(strOriginal) - Pos)
Else
strTemp = Left(strOriginal, Pos - 2)
strOriginal = Right(strOriginal, Len(strOriginal) - Pos + 1) 'save new strOriginal
Pos = InStr(1, strOriginal, ",")
strToken = Mid(strTemp, 1, Pos)
strTemp = Right(strTemp, Len(strTemp) - Pos)
Pos = InStr(1, strTemp, ",")
If Pos = 0 Then
Pos = InStr(1, strTemp, "|")
End If
strToken = strToken + Mid(strTemp, 1, Pos - 1)
Token.Add strToken
Token.Add Right(strTemp, Len(strTemp) - Pos)
End If
Wend
Dim strItem As Variant
For Each strItem In Token
Debug.Print strItem
Next strItem
End Sub

Answer 3

Try,
Sub Split4thdelim()
Dim strOriginal As String
Dim originalArry() As String
Dim X As Long
Dim vSplit, s As String, s2 As String
Dim vR()
Dim n As Long
strOriginal = "01/01/2020|user1,89|user2,90|user3,99,02/01/2020|user1,80|user2,85|user3,97,03/01/2020|user1,88|user2,96|user3,99"
originalArry = Split(strOriginal, "|")
For X = LBound(originalArry) To UBound(originalArry)
'Debug.Print originalArry(X)
s = originalArry(X)
If InStr(s, "/") And InStr(s, ",") Then
n = n + 2
vSplit = Split(s, ",")
s2 = vSplit(UBound(vSplit))
ReDim Preserve vR(1 To n)
vR(n - 1) = Replace(s, "," & s2, "")
vR(n) = s2
Else
n = n + 1
ReDim Preserve vR(1 To n)
vR(n) = s
End If
Next
Range("a1").Resize(n) = WorksheetFunction.Transpose(vR)
End Sub

Answer 4

or ...
Option Explicit
Sub Split4thdelim()
Dim strOriginal As String
Dim vCounter As Long
Dim vNewElement As String
Dim vCommaCount As Long
strOriginal = "01/01/2020|user1,89|user2,90|user3,99,02/01/2020|user1,80|user2,85|user3,97,03/01/2020|user1,88|user2,96|user3,99"
vNewElement = ""
vCommaCount = 0
For vCounter = 1 To Len(strOriginal)
If Mid$(strOriginal, vCounter, 1) <> "|" And Mid$(strOriginal, vCounter, 1) <> "," Then
vNewElement = vNewElement & Mid$(strOriginal, vCounter, 1)
Else
If Mid$(strOriginal, vCounter, 1) = "|" Then
Debug.Print vNewElement
vNewElement = ""
vCommaCount = 0
ElseIf Mid$(strOriginal, vCounter, 1) = "," Then
vCommaCount = vCommaCount + 1
If vCommaCount = 2 Then
Debug.Print vNewElement
vNewElement = ""
vCommaCount = 0
Else
vNewElement = vNewElement & Mid$(strOriginal, vCounter, 1)
End If
End If
End If
Next
Debug.Print vNewElement
End Sub