Need help improving my VBA loop

Question

I have an Excel Worksheet consisting of two columns, one of which is filled with strings and the other is emtpy. I would like to use VBA to assign the value of the cells in the empty column based on the value of the adjacent string in the other column.

I have the following code:

Dim regexAdmin As Object 
Set regexAdmin = CreateObject("VBScript.RegExp") 
regexAdmin.IgnoreCase = True
regexAdmin.Pattern = "Admin" 

Dim i As Integer
For i = 1 To 10 'let's say there is 10 rows
    Dim j As Integer
    For j = 1 To 2
        If regexAdmin.test(Cells(i, j).Value) Then
            Cells(i, j + 1).Value = "Exploitation"
        End If
    Next j
Next i

The problem is that when using this loop for a big amount of data, it takes way too long to work and, most of the time, it simply crashes Excel.

Anyone knows a better way to this?

Answer 1

Try this:

Public Sub ProcessUsers()

    Dim regexAdmin As Object
    Set regexAdmin = CreateObject("VBScript.RegExp")
    regexAdmin.IgnoreCase = True
    regexAdmin.Pattern = "Admin"

    Dim r As Range, N As Integer, i As Integer
    Set r = Range("A1") '1st row is headers
    N = CountRows(r) - 1 'Count data rows

    Dim inputs() As Variant, outputs() As Variant
    inputs = r.Offset(1, 0).Resize(N, 1) ' Get all rows and 1 columns
    ReDim outputs(1 To N, 1 To 1)

    For i = 1 To N
        If regexAdmin.test(inputs(i, 1)) Then
            outputs(i, 1) = "Exploitation"
        End If
    Next i

    'Output values
    r.Offset(1, 1).Resize(N, 1).Value = outputs
End Sub


Public Function CountRows(ByRef r As Range) As Long
    If IsEmpty(r) Then
        CountRows = 0
    ElseIf IsEmpty(r.Offset(1, 0)) Then
        CountRows = 1
    Else
        CountRows = r.Worksheet.Range(r, r.End(xlDown)).Rows.Count
    End If
End Function

Answer 2

You have an unnecessary loop, where you test the just completed column (j) too. Dropping that should improve the speed by 10-50%

Dim regexAdmin As Object 
Set regexAdmin = CreateObject("VBScript.RegExp") 
regexAdmin.IgnoreCase = True
regexAdmin.Pattern = "Admin" 

Dim i As Integer
For i = 1 To 10 'let's say there is 10 rows
        If regexAdmin.test(Cells(i, 1).Value) Then
            Cells(i, 1).offset(0,1).Value = "Exploitation"
        End If
Next i

If the regex pattern really is simply "Admin", then you could also just use a worksheet formula for this, instead of writing a macro. The formula, which you'd place next to the text column (assuming your string/num col is A) would be:

=IF(NOT(ISERR(FIND("Admin",A1))),"Exploitation","")

In general, if it can be done with a formula, then you'd be better off doing it so. it's easier to maintain.