3

I am trying to speed up a currently working automated workbook.

PHP sends a string similar to the below to VBA:

1[|:#:|]text-one[|:#:|]code-one[|:#:|]qty-one[{:#:}]
2[|:#:|]text-two[|:#:|]code-two[|:#:|]qty-two[{:#:}]

where

  • [|:#|] represents "new column"
  • [{:#:}] represents "new row"

When it is parsed by the VBA this is the output:

I currently use the following VBA code to parse this into a workbook:

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 am about to start optimising the code in this workbook and I am aware I can do something like (pseudo code):

for each element....
    Range("C2:F2").Value = Split(element, "[|:#:|]") 'Example row number would be incremental

However is there a way to do it so that I can split into the entire Range?

For example, If I know there are 29 "rows" within the data that has been returned, I would like to be able to use split to place the data into all the rows.

I imagine the syntax would be something similar to the below, however this doesn't seem to work:

Range("C2:F29").Value = Split(Split(element, "[|:#:|]"),"[{:#:}]")
Improve this question

2 Answers 2

Reset to default
2

The optimal thing to do is to do everything in native VBA code and not interact with the Excel sheet until the end. Writing to sheet is a time consuming operation, so this procedure does it once and once only, writing the whole two-dimensional array at once, rather than writing it line by line. Therefore no need to disable screen updating, calculation, 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

Example usage:

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 [{:#:}], could add this line at the top of the function:

If Right(phpString, 7) = "[{:#:}]" Then phpString = Left(phpString, Len(phpString) - 7)
Improve this answer
Sign up to request clarification or add additional context in comments.

Comments

1

This wasn't as easy as I originally thought. I can get rid of one loop easily. But there's still an if test, so it doesn't break on empty strings etc. I feel a guru could make this even more efficient.

My worry is that for you this process is taking a lot of time. If you are trying to speed things up, your code doesn't look too horribly inefficient. More likely if it's running slowly, is that the application.calculation & application.screenUpdating settings are set incorrectly.

Sub takePHP(myString As String)
'This sub takes specially formatted strings from a PHP script,
'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
Improve this answer

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.