Macros - speed (loops)

[jachym]

Hi guys,

I am quite new to VBA programming, but I have some experience with other computer languages so it is not that complicated for me.

I created several macros and I ran into a problem. I created several useful macros, which should speed up my work. However, this turned out to be only theoretical.

I will include just one example, but I struggle with the same issue in the other macros too. Theoretically they work fine and do what I want them to do, but the problem is speed. I tested them using a sheet with just a few cells. It worked and I was happy about it, but only until I opened a real file and tried to use it.

Example:
This macro was supposed to select all cells larger than user selected value. Very useful for me. It works, but when I tested it with a large document, i. e. document of a size I normally work with (approximately 20k rows and 25 columns) it was so slow that in the end the entire Excel froze. Trying for the second time it worked and selected the cells after about 3 minutes.... and I am using a relatively fast PC with i5 processor and 32GB of RAM.

Sub SelectCellsLarger()
    Dim ws As Worksheet
    Dim SelectCells As Range
    Dim xcell As Object
    Set ws = ActiveSheet
    Dim value As String
    Dim n As Integer

    n = 0
    
    value = InputBox("Insert a value", "")
    If IsNumeric(value) = False Then
        MsgBox "Insert a numeric value"
        Exit Sub
    End If
    
    If StrPtr(value) = 0 Then
        Exit Sub
    End If
    
    For Each xcell In ws.UsedRange.Cells
    If xcell.value > value And IsNumeric(xcell.value) = True And IsEmpty(xcell.value) = False Then
        n = n + 1
        If SelectCells Is Nothing Then
        Set SelectCells = Range(xcell.Address)
        Else
        Set SelectCells = Union(SelectCells, Range(xcell.Address))
        End If
    End If
    Next
    On Error Resume Next
    SelectCells.Select
    MsgBox "Selected" & n & " cells."
End Sub

The above code theoretically works for small number of cells, but in practice is unusable. My question is, is there a way to make this more efficient? Make it select the cells in say a few seconds? Are loops the only way of doing this and in general, is it normal for loops to take this long to execute?

Thanks in advance for any tips and info

 

[Fluff]

Do you need to select the cells, or would highlighting them be ok?

 

[Eric W]

You've bumped up against an issue that isn't as well known as it should be. In short, referencing a worksheet from VBA is pretty slow! When working with a small sheet, it's not noticeable, but with larger ones, very much so. But reading a block of cells is just as fast as reading one cell, the same with writing. So the usual answer is to read the entire range you want, store it in an array, process it as needed (working with internal arrays is much faster in VBA), then write it back in one instruction. For example,

Dim i as long, c as Range
For each c in Range("A1:A10")
   c.value = c.value + 1
Next c

can be replaced with

Dim i as long, MyArray as Variant
MyArray = Range("A1:A10").Value
For i = 1 to UBound(MyArray)
   MyArray(i, 1) = MyArray(i, 1) + 1
Next i
Range("A1:A10").Value = MyArray

and would be much faster (if the range is large enough). There are various tricks you can learn to facilitate this in different situations.

 

[JoeMo]

I don't have a fix for you, but this may be a starting point although I don't have the time to pursue it further. It's along the lines that Eric W has suggested. When I run it on a small block of say 160 cells it works well, but if the block is twice that size it throws a run time error at the line: ActiveSheet.Range(StrAdr).Select

My guess is there's some limit on the number of characters the variable StrAdr can have. If that's the case, perhaps it could be used by segmenting the used range into smaller blocks and looping through the blocks. I used a block of integers between 0 and 100 for this and it asks the user to input a value in that range, then selects all cells with a value greater than the user input value.

Sub SelectIf()
Dim FrstRw As Long, FrstCol As Long
Dim V As Variant, Valu As Variant, i As Long, j As Long, StrAdr As String
With ActiveSheet.UsedRange
    FrstRw = .Cells(1, 1).Row
    FrstCol = .Cells(1, 1).Column
End With
   
V = ActiveSheet.UsedRange.Value
Valu = InputBox("Insert a value between 0 and 100", "")
If IsNumeric(Valu) = False Then
    MsgBox "Insert a numeric value"
    Exit Sub
End If
If StrPtr(Valu) = 0 Then
    Exit Sub
End If
For i = 1 To UBound(V, 1)
    For j = 1 To UBound(V, 2)
        If IsNumeric(Val(V(i, j))) And Val(V(i, j)) > Valu Then
            StrAdr = StrAdr & "," & Cells(i + FrstRw - 1, j + FrstCol - 1).Address(0, 0)
        End If
    Next j
Next i
If Not StrAdr = "" Then
    StrAdr = Right(StrAdr, Len(StrAdr) - 1)
    ActiveSheet.Range(StrAdr).Select
Else
    MsgBox "No cells with value > " & Valu & " found."
End If
End Sub

 

[Fluff]

If you are happy to highlight the cells you could use

Sub jachym()
   Dim Ary As Variant, Numb As Variant
   Dim r As Long, c As Long
   
   Numb = InputBox("Insert a vlaue")
   If IsNumeric(Numb) = False Then
      MsgBox "Insert a number"
      Exit Sub
   End If
   Numb = Val(Numb)
   Ary = ActiveSheet.UsedRange
   For r = 1 To UBound(Ary)
      For c = 1 To UBound(Ary, 2)
         If IsNumeric(Ary(r, c)) And Ary(r, c) > Numb Then
            Cells(r, c).Interior.Color = vbYellow
         End If
      Next c
   Next r
End Sub

 

[Fluff]

If you want the count of cells found

Sub jachym()
   Dim Ary As Variant, Numb As Variant
   Dim r As Long, c As Long, Q As Long
   
   Application.ScreenUpdating = False
   Numb = InputBox("Insert a value")
   If IsNumeric(Numb) = False Then
      MsgBox "Insert a number"
      Exit Sub
   End If
   Numb = Val(Numb)
   Ary = ActiveSheet.UsedRange
   For r = 1 To UBound(Ary)
      For c = 1 To UBound(Ary, 2)
         If IsNumeric(Ary(r, c)) And Ary(r, c) > Numb Then
            Q = Q + 1
            Cells(r, c).Interior.Color = vbYellow
         End If
      Next c
   Next r
   MsgBox Q & "cells found"
End Sub

With 20,000 rows & 25 columns, this took me ~11 seconds with ~400,000 cells found

 

[Eric W]

JoeMo, I don't believe there's an upper limit to the size of the string, I've had strings with hundreds of thousands of characters. But I think there is a limit to the number of ranges separated by commas you can give the Range object. I can't remember the actual number . I know I've seen threads in this forum discussing this, if I can figure out the right key words to find them.

Fluff, one thing to keep in mind is that the UsedRange doesn't necessarily start at A1. To be safe, you'd need to check the .Row and .Column properties to find the upper left cell. You can see how JoeMo did it.

 

[JoeMo]

JoeMo, I don't believe there's an upper limit to the size of the string, I've had strings with hundreds of thousands of characters. But I think there is a limit to the number of ranges separated by commas you can give the Range object. I can't remember the actual number . I know I've seen threads in this forum discussing this, if I can figure out the right key words to find them.

Thanks Eric. In this case, the length of the string reflects the number of ranges (cells) in the range object. If you come across a relevant thread, I'd greatly appreciate you posting a link to it on this thread.

 

[Fluff]

Fluff, one thing to keep in mind is that the UsedRange doesn't necessarily start at A1.

Excellent point Eric, I'm so used to data starting in A1 that I never thought of that.

 

[jachym]

Thanks everyone for your tips, I will try the array trick if that helps.