Array Helper 1

[DreXor]

If you've ever worked with repeatative arrays, with multiple delimiters... split, then split again inside a loop to try and get everything separated, this might help :


Function ReSplit(OriginArray, sDelimiter As String, Optional CompareMethod As Long = vbBinaryCompare) As Variant
If IsArray(OriginArray) Then
Dim OutputArray() As String, iArrayUpper As Integer, FirstInSet As Integer, NewUbound As Integer
NewUbound = -1
For ArrayPosition = 0 To UBound(OriginArray)
NewUbound = NewUbound + 1
SubString = OriginArray(ArrayPosition)
FirstInSet = InStr(1, SubString, sDelimiter, CompareMethod)
Do While FirstInSet > 0
ReDim Preserve OutputArray(NewUbound)
OutputArray(NewUbound) = Left(SubString, FirstInSet - 1)
SubString = Right(SubString, Len(SubString) - FirstInSet)
FirstInSet = InStr(1, SubString, sDelimiter, CompareMethod)
NewUbound = NewUbound + 1
Loop
ReDim Preserve OutputArray(NewUbound)
OutputArray(NewUbound) = SubString
Next
ReSplit = OutputArray
Else
ReSplit = Array("Error")
End If
End Function



Sample Usage :

dim blah()

blah = Split("a,b,c,d,f!g!h!i,j,k,l",",")
' pretty straight foreward, (8 spots (7 dim)) ..but you don't have a broken down full group of each letter so....
blah = ReSplit(blah,"!")
' this reconstructs the blah array into one full array (11 spots (10 dim))

can come in very handy in string manipulations, sorting out large masses of text, second example : web pages...

dim blah()

blah = split(webcontent,"<")
blah = ReSplit(blah,">")

' this results in every other item in the array to alternate between tag content and page content, even if it's empty like <table><tr>

 

[DreXor]

Update!!!

forgot to count in the length of the "delimiter" in case it's more than a single character.

updated function :

Function ReSplit(OriginArray, sDelimiter As String, Optional CompareMethod As Long = vbBinaryCompare) As Variant
  If IsArray(OriginArray) Then
    Dim OutputArray() As String, iArrayUpper As Integer, FirstInSet As Integer, NewUbound As Integer
    NewUbound = -1
    For ArrayPosition = 0 To UBound(OriginArray)
      NewUbound = NewUbound + 1
      SubString = OriginArray(ArrayPosition)
      FirstInSet = InStr(1, SubString, sDelimiter, CompareMethod)
      Do While FirstInSet > 0
        ReDim Preserve OutputArray(NewUbound)
        OutputArray(NewUbound) = Left(SubString, FirstInSet - 1)
        SubString = Right(SubString, Len(SubString) - FirstInSet[COLOR=black cyan] - Len(sDelimiter)[/color])
        FirstInSet = InStr(1, SubString, sDelimiter, CompareMethod)
        NewUbound = NewUbound + 1
      Loop
      ReDim Preserve OutputArray(NewUbound)
      OutputArray(NewUbound) = SubString
    Next
    ReSplit = OutputArray
  Else
    ReSplit = Array("Error")
  End If
End Function

DreX
aKa - Robert

 

[DreXor]

update yet again .. where the blue highlight, you might need to include a +1 in there otherwise the first letter might become truncated.

SubString = Right(SubString, Len(SubString) - FirstInSet - Len(sDelimiter)+1)


DreX
aKa - Robert
if all else fails, light it on fire and do the happy dance!