Is there a faster option than this foreach loop in a vba macro?

user_6291159 0
Viewed 199

I am trying to create a macro to format my stock sheets. I need to only show values up to 8 and then show 9+ for any value over that. I also need to get rid of any 0's or negative numbers.

I need to run this loop 4 times on columns C, D, E and F and the file is about 15,000 lines long. The code works when I debug it, but it crashes the application if it just runs through. I know I can't loop through that much, but is there another way that I can do it?

Call SetStockLevels(range("C3:C" & lastRow))

Private Sub SetStockLevels(range As range)

    For Each c In range
        If c.Value < 1 Then
            c.ClearContents
        ElseIf c.Value > 8 Then
            c.Value = "9+"
        End If
    Next

End Sub

I already have these funtions that I call at the start and the end of the macro respectively.

Public Sub speedup()

    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

End Sub

Public Sub normal()

    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

End Sub
each for-loop vba excel
2 Answers

This method stores the range value in an array and process from it which should be much faster than looping through cell by cell.

If your starting and ending row in column C-F are the same, you can pass the entire range and process it together.

Option Explicit

Private Sub Test()
    Dim lastRow As Long
    lastRow = Sheet1.Range("C" & Sheet1.Rows.Count).End(xlUp).Row
    
    SetStockLevels Sheet1.Range("C3:F" & lastRow)
End Sub

Private Sub SetStockLevels(setRng As Range)

    Dim tempArr As Variant
    
    tempArr = setRng.Value
    
    Dim i As Long
    Dim j As Long
    For j = LBound(tempArr, 2) To UBound(tempArr, 2)
        For i = LBound(tempArr, 1) To UBound(tempArr, 1)
            Select Case tempArr(i, j)
                Case Is < 1: tempArr(i, j) = ""
                Case Is > 8: tempArr(i, j) = "9+"
            End Select
        Next i
    Next j
    
    setRng.Value = tempArr
End Sub
user_155979360

Experiment with Regular Expressions

I thought regexp replacements would work faster, but it takes almost similar time...

Sub SetStockLevels()
Dim StartTime As Double
Dim SecondsElapsed As Double
'Remember time when macro starts
  StartTime = Timer
'________________Timer Start_______________
Dim myrng As Range, mystr As String, arr, col As Range
Dim lastRow As Long, i As Long

Dim regex As Object, mc As Object
Set regex = CreateObject("VBScript.regexp")
regex.ignorecase = False
regex.Global = True

lastRow = Sheet1.Range("C" & Sheet1.Rows.Count).End(xlUp).Row
Set myrng = Sheet1.Range("C3:F" & lastRow)

For Each col In myrng.Columns
    mystr = "," & Join(Application.Transpose( _
        Application.Index(col.Value, 0, 1)), ",") & ","
    
    regex.Pattern = "-\d*(\.?\d*)" 'for negative numbers including decimal
    mystr = regex.Replace(mystr, "")
    regex.Pattern = ",0," 'for zeros
    mystr = regex.Replace(mystr, ",,")
'__________________________________________________________________
    'for numbers with decimals skip below two regex replacements _
    'and use the loop below. Not sure how to get regex match for decimals > 8
    regex.Pattern = "[0-9]{2,}" 'for numbers greater than 9
    mystr = regex.Replace(mystr, "9+")
    regex.Pattern = ",9," 'for Nine (Single digit)
    mystr = regex.Replace(mystr, ",9+,")
'__________________________________________________________________

    arr = Split(Mid(mystr, 2, Len(mystr) - 2), ",")
    
'    For i = 0 To UBound(arr)
'        If arr(i) <> "" And arr(i) > 8 Then arr(i) = "9+"
'    Next i
    
    col.Value = Application.Transpose(arr)
Next col

'________________Timer End_______________
'Determine how many seconds code took to run
  SecondsElapsed = Round(Timer - StartTime, 2)
'Notify user in seconds
  Debug.Print "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation

End Sub
user_98080630
Related