Row loop to Array loop-CodePudding

I tried and failed to transform the current row by row loop here below in a much more performant array loop.

The problem i face is that the results do not match with the row loop as it should.

What i need to change from this current loop to transform it into an array loop that behaves equally on the output given ?

To give a bit of background it iterates over a range (if values are not empty ) to form a very simple xml in string format

Like this :

<rows><r><i>0</i><i></i><i>3495776</i><i>0200</i><i>DF-252</i><i></i></r><r><i>0</i><i></i><i>3495777</i><i>0200</i><i>DF-252</i><i></i></r></rows>

Dim rData       As Variant
        Dim rRow        As Range
        Dim i           As Long
        Dim xmlData     As String
        Dim strText     As String
        
        
        '-- Read the data --
        Set rData = Worksheets("ProtectedSheet").Range("D2:I1048576")
              
        For Each rRow In rData.Rows
            If Not rRow Is Nothing Then
                If Len(Trim(rRow.Cells(1).Value2)) > 0 Then
                    xmlData = xmlData   "<r>"
                    
                    For i = 1 To rRow.Cells.Count
                        strText = rRow.Cells(i).Value2
                                              
                        xmlData = xmlData   "<i>"   strText   "</i>"
                       
                    Next i
                    
                    xmlData = xmlData   "</r>"
                Else
                 Exit For
                End If
        End If
            
    
        Next rRow
        
        xmlData = "<rows>"   xmlData   "</rows>"

CodePudding user response：

This should do what you want:

Sub test()
Dim arrData     As Variant
Dim rRow        As Long
Dim rCell       As Long
Dim i           As Long

Dim xmlData     As String
Dim strText     As String


'-- Read the data into an array --> much better performance
arrData = ActiveSheet.Range("A2:C1000") '>>> adjust to your needs
      
For rRow = 1 To UBound(arrData, 1)
    If Len(Trim(arrData(rRow, 1))) > 0 Then     'only read rows where first cell <> empty
        xmlData = xmlData   "<r>"
        For rCell = 1 To UBound(arrData, 2)
            strText = Trim(arrData(rRow, rCell))
            xmlData = xmlData   "<i>"   strText   "</i>"
        Next
            
        xmlData = xmlData   "</r>"
    End If
Next

xmlData = "<rows>"   xmlData   "</rows>"

End Sub

Your code exits the for loop when the first cell of a row is empty - and won't handle the rest of the rows.

Moreover: you should read your data into an array (variant) - as this will be much faster to be read by the for-next-loop.

By the way you can achieve this with a formula as well:

=VSTACK("<rows>",
       BYROW(A2:C1000001,
               LAMBDA(r,"<r><i>"&TEXTJOIN("</i><i>",FALSE,r)&"</i></r>")),
       "</rows>")

CodePudding user response：

Just update your i variable from this:

Dim i As Long

To this:

Dim i As Variant

And update your For Loop from this:

For i = 1 To rRow.Cells.Count
    strText = rRow.Cells(i).Value2
                          
    xmlData = xmlData   "<i>"   strText   "</i>"
   
Next i

To this:

For Each i In rRow.Value2
    xmlData = xmlData   "<i>"   CStr(i)   "</i>"
Next i

This loop will take into consideration all the values from the row.