Populate the call data to 2D array speedy

[Ongbey]

Hi,

I have speed complaint about populate the cell values to the 2D arrays. I copied a part of VBA code to here.
Please suggest a speedy code.
Thanks in advance.

VBA CODE
------------------------------------------------
Public List(11, 5), dimsayi As Integer
Public Sub Test()
-------------------------------------------------
sayi = [B1]: dimsayi = 0

For n = 4 To sayi * 4 Step 4
dimsayi = dimsayi + 1
List(dimsayi, 1) = 2: List(dimsayi, 2) = Cells(n, 1): List(dimsayi, 3) = Cells(n + 1, 1): List(dimsayi, 4) = Cells(n + 2, 1): List(dimsayi, 5) = Cells(n + 3, 1)
Next n
End Sub
--------------------------------------------------

B1 formula = (C1-3)/4
C1 formula =MATCH("TOTAL";A1:A400;0)-1

17719
PART1
1
PCS
17720
PART2
1
PCS
17722
PART3
1
PCS
17726
PART4
1
PCS
35147
PART5
1
PCS
53860
PART6
2
PCS
53925
PART7
4
PCS
6403055E
PART8
1
PCS
68631
PART9
0,1
PCS
68733
PART10
0,00833
PCS
74147
PART11
2
PCS
TOTAL

 

[Legacy 143009]

Merhaba,

List(dimsayi, 1) = 2

Are all 1st dimension values going to be 2?

 

[Ongbey]

Merhaba
Yes, it is always 2

 

[Ongbey]

In my VBA, there are many loop like that and it takes too time. Is there any speedy method for to do that?

 

[Legacy 143009]

Ok,

I came up with a solution like below. It is a jagged array (array of arrays):

Sub test()
  Dim List As Variant, dimsayi As Long
  dimsayi = Range("B1").Value
  ReDim List(1 To dimsay)
  For i = 1 To UBound(List)
    List(i) = Split(Evaluate("=TEXTJOIN("";"",0,2,OFFSET(A" & i * 4 & ",0,0,4))"), ";")
  Next
End Sub

You can access values like List(1)(0). 1 means first row. 0 means first column, in this case, it is value 2.

 

[Legacy 143009]

A more friendly version would be:

Sub test()
  Dim List As Variant, dimsayi As Long
  dimsayi = Range("B1").Value
  ReDim List(1 To dimsayi)
  For i = 1 To UBound(List)
    List(i) = Split(WorksheetFunction.TextJoin(";", 0, 2, Cells(i * 4, 1).Resize(4)), ";")
  Next
End Sub

 

[Georgiboy]

Perhaps refering to the sheet less will speed it up:

Option Explicit

Public List As Variant, dimsayi As Integer

Public Sub Test()
    Dim sayi As Long, n As Long, var As Variant, tRow As Long, x As Long
    
    tRow = Sheet1.Range("A1:A400").Find("TOTAL", , , xlWhole).Row
    sayi = (tRow - 4) / 4
    var = Sheet1.Range("A4:A" & tRow - 1).Value
    ReDim List(sayi - 1, 4)

    For n = 1 To sayi * 4 Step 4
        List(dimsayi, 0) = 2
        For x = 1 To 4
            List(dimsayi, x) = Trim(var(n + x - 1, 1))
        Next x
        dimsayi = dimsayi + 1
    Next n
End Sub

 

[Fluff]

@Flashbond The OP's profile shows 2013 & so doesn't have the Textjoin function.

 

[Legacy 143009]

@Flashbond The OP's profile shows 2013 & so doesn't have the Textjoin function.

Oh.. Very good point indeed. I thought like a VBA Built-in function Sorry for that. In this case I will go like @Georgiboy style nested loop:

Sub test()
  Dim List As Variant, dimsayi As Long, tmp As Variant
  dimsayi = Range("B1").Value
  tmp = Range("A4").Resize(dimsayi * 4)
  ReDim List(1 To dimsayi, 1 To 5)
  
  For i = 1 To dimsayi
    For j = 1 To 5
      Select Case j
      Case 1
      List(i, j) = 2
      Case Else
      List(i, j) = tmp(((i - 1) * 4) + (j - 1), 1)
      End Select
    Next
  Next
End Sub

 

[Legacy 143009]

A faster version would be:

Sub test()
  Dim List As Variant, dimsayi As Long, tmp As Variant
  dimsayi = Range("B1").Value
  tmp = Range("A4").Resize(dimsayi * 4)
  ReDim List(1 To dimsayi, 1 To 5)
  
  For i = 1 To dimsayi
    List(i, 1) = 2
    For j = 2 To 5
      List(i, j) = tmp(((i - 1) * 4) + (j - 1), 1)
    Next
  Next
End Sub