CODEWITHSUNDEEP
excelvba
user16978245
user16978245

Reputation:

Function is Extremely slow with 700K Rows Data

Using below function which performs well on short data but whenever i move on large data set it takes long time to processing and sometime stuck.

I would appreciate if there could be another faster way to perfrom this.

Sub minustozeo()
Dim c As Range
For Each c In Selection.SpecialCells(xlCellTypeVisible)
 If c.Value < 0 Then
 c.Value = 0
 End If
Next
End Sub

Upvotes: 1

Views: 131

Answers (1)

Tim Williams
Tim Williams

Reputation: 166316

Here's a faster method using the array approach:

Sub Tester()
    
    Dim ws As Worksheet, c As Range, t, rngVis As Range, rngVals As Range
    Dim arr, r As Long
    
    Set ws = ActiveSheet
    Set rngVals = ws.Range("A2:A500000") 'range to operate on
    
    'create some dummy data with about 70% < 0
    If ws.FilterMode Then ws.ShowAllData
    With rngVals
        .Formula = "=RAND()-0.7"
        .Value = .Value
    End With
    
    rngVals.Copy rngVals.Offset(, 2) 'for verification only...
    
    'autofilter
    rngVals.AutoFilter Field:=1, Criteria1:="<0", Operator:=xlAnd
        
    On Error Resume Next
    Set rngVis = rngVals.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If rngVis Is Nothing Then Exit Sub 'no cells found
    
    Debug.Print rngVis.Cells.Count 'approx 350k
    
    t = Timer
    arr = rngVals.Value 'read the data
    For Each c In rngVis.Cells
        If c.Value < 0 Then arr(c.Row - 1, 1) = 0 ' -1 because first array value is from row #2
    Next c
    rngVals.Value = arr     'write the altered data back
    Debug.Print Timer - t   ' ~1 sec
    
    ws.ShowAllData

End Sub

Upvotes: 2

Related Questions