CODEWITHSUNDEEP
vbaexcel
Pedro Lastra
Pedro Lastra

Reputation: 63

Vba. 300mb+ optimizing macro

(There is more code after/before the code below, this is the part were i want to optimize the loops)

Sheets("LeanReport").Activate

Dim lRow As Long
 On Error Resume Next
 lRow = Application.WorksheetFunction.Match("05 2016", Range("AB:AB"), 0)
 On Error GoTo 0
 If lRow > 0 Then
    'code
 End If

For i = 2 To LastrowLeanReport
    R1 = CStr(Cells(i, 5))
    RG1 = CStr(Cells(i, 24))

    MatrizRG1(i - 2) = RG1
    MatrizR1(i - 2) = R1
Next i

Sheets("Carrier").Activate

For i = 2 To LastrowCarrier
    RG2 = CStr(Cells(i, 1))
    MatrizRG2(i - 2) = RG2
Next i

For j = 2 To LastrowCarrier
    For p = lRow To LastrowLeanReport
        If MatrizRG2(j) = MatrizRG1(p) Then
            MatrizRG3(j) = Cells(j, 1)
            MatrizC1(j) = MatrizR1(p)
        End If
    Next p
    If MatrizRG3(j) = "" Then
        For x = 0 To lRow
            If MatrizRG2(j) = MatrizRG1(x) Then
                MatrizRG3(j) = Cells(j, 1)
                MatrizC1(j) = MatrizR1(p)
            End If
        Next x
    End If
Next j

Is there any way to optimize this macro? Lastrowleanreport has more than 700000 rows How can i change those loops for something else?

It gives me all the time error 6 & 7 out of memory.

Upvotes: 0

Views: 88

Answers (1)

Paul Ogilvie
Paul Ogilvie

Reputation: 25286

In stead of loading the data into matrices and then operate on the matrices, you could operate directly on the cells. Then you don't consume memory for the large matrices.

To achieve this, I first changed your code so I can find equivalent expressions. For example, you assign something to a matrix element and then later use this element. That usage is then equivalent to the expression with which you got data from the sheet and placed into the matrix element.

Once that is done, you can replace the matrix references in your last for loop with the cell references. Here I see something funny: your source worksheet has apparently 2 header rows that you skip. But then later in the for loop you skip them again, but now you also skip the first two matrix elements! I don't think that is what you mean:

For j = 0 To LastrowCarrier - 2
    For p = lRow To LastrowLeanReport
        If MatrizRG2(j + 2) = MatrizRG1(p) Then
            MatrizRG3(j + 2) = Cells(j + 2, 1)
            MatrizC1(j + 2) = MatrizR1(p)
        End If
    Next p
    If MatrizRG3(j + 2) = "" Then
        For x = 0 To lRow
            If MatrizRG2(j + 2) = MatrizRG1(x) Then
                MatrizRG3(j + 2) = Cells(j + 2, 1)
                MatrizC1(j + 2) = MatrizR1(p)
            End If
        Next x
    End If
Next j

In the above, I think that the expression j + 2 should be just j (except in the Cells expression). I continue on that premises. Note also that p in MatrizR1(p) is ill-defined as it points beyond the matrix (I leave this error to you to fix).

Next I introduced variables for the worksheets, so it is easier to address them. I changed the loops to start from zero to the row count - 2. This gives the following equivalent subroutine:

Dim sheetCarrier As Worksheet
Dim sheetReport As Worksheet
Dim lRow As Long

Set sheetReport = Sheets("LeanReport")
sheetReport.Activate
lRow = Application.WorksheetFunction.Match("05 2016", Range("AB:AB"), 0)

For i = 0 To LastrowLeanReport - 2
    MatrizRG1(i) = CStr(sheetReport.Cells(i + 2, 24))
    MatrizR1(i) = CStr(sheetReport.Cells(i + 2, 5))
Next i

Set sheetCarrier = Sheets("Carrier")

For i = 0 To LastrowCarrier - 2
    MatrizRG2(i) = CStr(sheetCarrier.Cells(i + 2, 1))
Next i

For i = 0 To LastrowCarrier - 2
    For p = lRow To LastrowLeanReport
        If MatrizRG2(i) = MatrizRG1(p) Then
            MatrizRG3(i) = sheetCarrier.Cells(i + 2, 1)
            MatrizC1(i) = MatrizR1(p)
        End If
    Next p
    If MatrizRG3(i) = "" Then
        For x = 0 To lRow
            If MatrizRG2(i) = MatrizRG1(x) Then
                MatrizRG3(i) = sheetCarrier.Cells(i + 2, 1)
                MatrizC1(i) = MatrizR1(p)
            End If
        Next x
    End If
Next I

In the next step, I now only have to replace the matrix references in the last loop with the cell references from the earlier loops. These equivalences are:

MatrizRG1(i) = CStr(sheetReport.Cells(i + 2, 24))
MatrizR1(i) = CStr(sheetReport.Cells(i + 2, 5))
MatrizRG2(i) = CStr(sheetCarrier.Cells(i + 2, 1))

(I don't know where your output in MatrizRG3 and MatrizC1 is going, so I leave that in the code - nice exercise for you.)

The equivalent subroutine without matrices then becomes:

Dim sheetCarrier As Worksheet
Dim sheetReport As Worksheet
Dim lRow As Long

Set sheetCarrier = Sheets("Carrier")
Set sheetReport = Sheets("LeanReport")
sheetReport.Activate
lRow = Application.WorksheetFunction.Match("05 2016", Range("AB:AB"), 0)

For i = 0 To LastrowCarrier - 2
    For p = lRow To LastrowLeanReport
        If CStr(sheetCarrier.Cells(i + 2, 1)) = CStr(sheetReport.Cells(p + 2, 5)) Then
            MatrizRG3(i) = sheetCarrier.Cells(i + 2, 1)
            MatrizC1(i) = CStr(sheetReport.Cells(p + 2, 5))
        End If
    Next p
    If MatrizRG3(i) = "" Then
        For x = 0 To lRow
            If CStr(sheetCarrier.Cells(i + 2, 1)) = CStr(sheetReport.Cells(x + 2, 24)) Then
                MatrizRG3(i) = sheetCarrier.Cells(i + 2, 1)
                MatrizC1(i) = CStr(sheetReport.Cells(p + 2, 5))   ' note: this 'p' is undefined!!
            End If
        Next x
    End If
Next i

If this works (and check it; errors are easily made), then we can go on to see if we can optimize it a bit more.

Upvotes: 2

Related Questions