Split row of data over columns AND rows using VBA
I am trying to speed up a currently automated workbook.
PHP sends a string similar to the one below to VBA:
1[|:#:|]text-one[|:#:|]code-one[|:#:|]qty-one[{:#:}]
2[|:#:|]text-two[|:#:|]code-two[|:#:|]qty-two[{:#:}]
Where
-
[|:#|]
represents a "new column" -
[{:#:}]
represents a "new line"
When it is parsed by VBA, this is the output:
I am currently using the following VBA code to parse this in a book:
myArray = Split(myReply, "[{:#:}]")
myRow = 1
For Each element In myArray
myRow = myRow + 1
subArray = Split(element, "[|:#:|]")
myCol = 2
For Each subelement In subArray
myCol = myCol + 1
Cells(myRow, myCol).Value = subelement
Next subelement
Next element
I'm about to start optimizing the code in this book and I know I can do something like (pseudocode):
for each element....
Range("C2:F2").Value = Split(element, "[|:#:|]") 'Example row number would be incremental
However, is there a way to do this so that I can split across the entire range?
For example, if I know that there are 29 "rows" in the returned data, I would like to use split
to place the data on all rows.
I am guessing the syntax would be something similar to the one below, however, it doesn't seem to work:
Range("C2:F29").Value = Split(Split(element, "[|:#:|]"),"[{:#:}]")
The optimal goal is to do everything in your own VBA code and not interact with the Excel worksheet until the end. Writing to a sheet is a laborious operation, so this procedure does it once and only once, writing the entire two-dimensional array at once, rather than writing it line by line. Therefore, there is no need to turn off screen refresh, computation or anything else.
Function phpStringTo2DArray(ByVal phpString As String) As Variant
Dim iRow As Long
Dim iCol As Long
Dim nCol As Long
Dim nRow As Long
Dim nColMax As Long
Dim lines() As String
Dim splitLines() As Variant
Dim elements() As String
lines = Split(phpString, "[{:#:}]")
nRow = UBound(lines) - LBound(lines) + 1
ReDim splitLines(1 To nRow)
For iRow = 1 To nRow
splitLines(iRow) = Split(lines(iRow - 1), "[|:#:|]")
nCol = UBound(splitLines(iRow)) - LBound(splitLines(iRow)) + 1
' in case rows have different number of columns:
If nCol > nColMax Then nColMax = nCol
Next iRow
Erase lines
'We now have a (Variant) array of arrays. Convert this to a regular 2D array.
ReDim elements(1 To nRow, 1 To nColMax)
For iRow = 1 To nRow
nCol = UBound(splitLines(iRow)) - LBound(splitLines(iRow)) + 1
For iCol = 1 To nCol
elements(iRow, iCol) = splitLines(iRow)(iCol - 1)
Next iCol
Next iRow
Erase splitLines
phpStringTo2DArray = elements
End Function
Usage example:
Dim s As String
Dim v As Variant
s = "1[|:#:|]text-one[|:#:|]code-one[|:#:|]qty-one[{:#:}]2[|:#:|]text-two[|:#:|]code-two[|:#:|]qty-two[{:#:}]"
v = phpStringTo2DArray(s)
'Write to sheet
Range("A1").Resize(UBound(v, 1), UBound(v, 2)) = v
If you want to ignore the final line break [{:#:}]
, you can add this line at the top of the function:
If Right(phpString, 7) = "[{:#:}]" Then phpString = Left(phpString, Len(phpString) - 7)
source to share
It wasn't as easy as I originally thought. I can easily get rid of one loop. But there is also an if test, so it doesn't break into empty lines, etc. I feel like a guru can make this even more effective.
My concern is that this process is taking a long time for you. If you're trying to speed up your work, your code doesn't look terribly inefficient. Most likely, if it is running slowly, it is that the application.calculation and application.screenUpdating parameters are set incorrectly.
Sub takePHP(myString As String)
'This sub takes specially formatted strings from a PHP ,
'and parses into rows and columns
Dim myRows As Variant
Dim myCols As Variant
Dim subRow As Variant
Application.ScreenUpdating = False
Application.Calculation = xlCalculateManual
myRows = Split(myString, "[{:#:}]")
x = 1
For Each subRow In myRows
bob = Split(subRow, "[|:#:|]")
If UBound(bob) <> -1 Then
Range(Cells(x, 1), Cells(x, UBound(bob) + 1)).Value = bob
x = x + 1
End If
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
source to share