CODEWITHSUNDEEP
excelvbaloopsif-statement
Ariel Ben David
Ariel Ben David

Reputation: 11

Loop an if function in a very large table. Too slow

I have a very large table. 700,000 rows. to get the information i need, i need to add a column that receives a simple if or function. the problem is, it is so slow. it calculated only 7000 rows in 60 seconds. i need 700,000... Using a regular excel function it works in a few seconds. there must be a way to do this with VBA. Thanks!!

Here is the code i have:

Private Sub CommandButton3_Click()
    Sheet1.Cells(1, 6) = "C & O"

     'count rows
    Dim count As Long
    For i = 1 To 1000000
        If Sheet1.Cells(i, 1) <> "" Then
            count = count + 1
       Else: Exit For
        End If
    Next

    'Fill in coulmn F
    For K = 2 To count
        If (Sheet1.Cells(K, 4) = 651 Or Sheet1.Cells(K, 4) = 652 Or Sheet1.Cells(K, 4) = 653 Or Sheet1.Cells(K, 4) = 805 Or Sheet1.Cells(K, 4) = 806 Or Sheet1.Cells(K, 4) = 808 Or Sheet1.Cells(K, 4) = 804 Or Sheet1.Cells(K, 4) = 807 Or Sheet1.Cells(K, 4) = 809 Or Sheet1.Cells(K, 4) = 810) Then
            Sheet1.Cells(K, 6) = "Oversize"
        Else
            Sheet1.Cells(K, 6) = Sheet1.Cells(K, 5)
        End If
    Next
End Sub

Upvotes: 1

Views: 322

Answers (3)

user4039065
user4039065

Reputation:

500K (half-a-million) rows in 0.96 seconds on a Surface 4 tablet.

Option Explicit

Public Sub CommandButton3_Click()
    Dim a As Long, arr As Variant
    Dim ca As Long

    appTGGL bTGGL:=False

    With Worksheets(Sheet1.Name)
        .Cells(1, 6) = "C & O"
        'you want count to be this,
        ca = .Cells(1, "A").End(xlDown).Row
        'it is more typically called like this,
        ca = .Cells(.Rows.count, "A").End(xlUp).Row

        'grab 2-D array of values from columns D:F
        arr = .Range(.Cells(1, "D"), .Cells(ca, "F")).Value2

        'loop through array
        For a = LBound(arr, 1) To UBound(arr, 1)
            Select Case arr(a, 1)
                Case 651, 652, 653, 804, 805, 806, 807, 808, 809, 810
                    arr(a, 2) = "oversize"
                Case Else
                    arr(a, 2) = arr(a, 3)
            End Select
        Next a

        'put the modified 2-D array back into the worksheet
        .Range(.Cells(1, "D"), .Cells(ca, "F")).Value2 = arr
    End With

    appTGGL

End Sub

Public Sub appTGGL(Optional bTGGL As Boolean = True)
    With Application
        .ScreenUpdating = bTGGL
        .EnableEvents = bTGGL
        .DisplayAlerts = bTGGL
        .AutoRecover.Enabled = bTGGL   'no interruptions with an auto-save
        .Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
        .CutCopyMode = False
        .StatusBar = vbNullString
    End With
    Debug.Print Timer
End Sub

I have include a 'helper' column that temporarily suspends various application environment settings in order to speed up the procedure.

Upvotes: 1

jivko
jivko

Reputation: 430

I would do it in the following way:

Application.ScreenUpdating = False

Dim cell As Range

For Each cell In Range(Range("A2"), Range("A2").End(xlDown))

    If (cell.Value >= 651 And cell.Value <= 653) Or _
        (cell.Value >= 804 And cell.Value <= 810) Then
        cell.Offset(0, 5).Value = "Oversize"
    Else
        cell.Offset(0, 5).Value = cell.Offset(0, 4).Value
    End If

Next cell

This ran 1 sec with 37000 rows of data.

Upvotes: 1

smartobelix
smartobelix

Reputation: 748

Simple optimization could be to read Cell content only once (it is quite slow):

Dim k4
For K = 2 To count
    k4 = Sheet1.Cells(K, 4) 
    If (k4 = 651 Or k4 = 652 Or k4 = 653 Or k4 = 805 Or k4 = 806 Or k4 = 808 Or k4 = 804 Or k4 = 807 Or k4 = 809 Or k4 = 810) Then
        Sheet1.Cells(K, 6) = "Oversize"
    Else
        Sheet1.Cells(K, 6) = Sheet1.Cells(K, 5)
    End If
Next

If this is not enough then convertion to array might be necassary.

Upvotes: 1

Related Questions