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

 

[GWteB]

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.

Not exactly the same issue, nevertheless quite similar ...

.clearcontents seems to max out

hey guys.... i have a sheet with alot of areas that i need to clear the contents of once i have used the sheet. The problem is that using the built in macro maker it seems to max out how many areas i can do and not only that but it seems that after i go over a certain amount it seemingly...

www.mrexcel.com

 

[JoeMo]

Not exactly the same issue, nevertheless quite similar ...

.clearcontents seems to max out

hey guys.... i have a sheet with alot of areas that i need to clear the contents of once i have used the sheet. The problem is that using the built in macro maker it seems to max out how many areas i can do and not only that but it seems that after i go over a certain amount it seemingly...

www.mrexcel.com

Thanks for the reference. I don't have the time to pursue this, but I wonder if selecting the named range would cause an error while just clearing the contents would not.

 

[GWteB]

I wonder if selecting the named range would cause an error while just clearing the contents would not.

The Select statement is not the bottleneck, the transfer / storage of multiple addresses within one Range object is.
As Eric said, a String variable has hardly any limitations in terms of size. The limit to the number of arguments (addresses) that can passed on to the Range object is causing you a run-time error. In the referenced thread the OP tried to provide 48 separate addresses to one range object. He used the macro recorder and afterwards he experienced a gap within the selected (segmented) range. In the code below the addresses of the referenced thread are used. Stepping through the code will visualize the limitations when multiple ranges together are given a name. Something for @jachym to take into account.

Public Sub Test()
    Const cRng  As String = "C2:C33,E2:M33,C36:C66,E36:M66,C69:C98,E69:M98,C101:C129,E101:M129,C132:C159,E132:M159,C162:C188,E162:M188,C191:C216,E191:M216," & _
                            "C219:C243,E219:M243,C246:C269,E246:M269,C272:C294,E272:M294,C297:C318,E297:M318,C321:C341,E321:M341,C344:C363,E344:M363,C366:C385," & _
                            "E366:M385,C388:C404,E388:M404,C407:C423,E407:M423,C426:C441,E426:M441,C444:C464,E444:M464,C467:C486,E467:M486,C489:C509,E489:M509," & _
                            "C512:C531,E512:M531,C534:C554,E534:M554,C557:C576,E557:M576,C579:C599,E579:M599"
    Dim oWs     As Worksheet
    Dim r       As Range
    Dim rngOne  As Range
    Dim rngTwo  As Range
    Dim rngUni  As Range
    Dim aryAddr As Variant
    Dim i       As Integer

    Set oWs = ThisWorkbook.Sheets.Add

'   ___ Assign a reference will error out
    'Set r = oWs.Range(cRng)
'   ___ Select will error out
    'oWs.Range(cRng).Select
'   ___ ClearContents will also error out
    'oWs.Range(cRng).ClearContents

'   ___ cut string with 48 addresses in half
    i = Len(cRng) / 2
    i = InStr(i, cRng, ",")
    Set rngOne = oWs.Range(Right(cRng, Len(cRng) - i))
    Set rngTwo = oWs.Range(Left(cRng, i - 1))

    ActiveWindow.Zoom = 10
    ActiveWindow.ScrollRow = 200
    rngOne.Interior.ColorIndex = 3
    rngTwo.Interior.ColorIndex = 4

'   ____ works as expected
    Union(rngOne, rngTwo).Select
    Selection.Interior.Pattern = xlPatternChecker

'   ___ address information is lost
    oWs.Parent.Names.Add Name:="FromSel", RefersTo:="=" & oWs.Name & "!" & Selection.Address
    Range("FromSel").Interior.ColorIndex = 5

    Set r = Selection
    r.Interior.Pattern = xlPatternLightHorizontal
    oWs.Parent.Names.Add Name:="FromRng", RefersTo:="=" & oWs.Name & "!" & r.Address
    Range("FromRng").Interior.ColorIndex = 2

    Set r = Union(rngTwo, rngOne)
    r.Interior.Pattern = xlPatternLightDown
    oWs.Parent.Names.Add Name:="FromUni", RefersTo:="=" & oWs.Name & "!" & r.Address
    Range("FromUni").Interior.ColorIndex = 7

'   ____ collecting addresses one by one
    aryAddr = Split(cRng, ",")
    Set rngUni = oWs.Range(aryAddr(0))
    For i = 1 To UBound(aryAddr)
        Set rngUni = Union(rngUni, oWs.Range(aryAddr(i)))
    Next i

    rngUni.Interior.ColorIndex = 8
    oWs.Parent.Names.Add Name:="FromUni", RefersTo:="=" & oWs.Name & "!" & rngUni.Address
    Range("FromUni").Interior.ColorIndex = 7
    rngOne.Interior.ColorIndex = 3
End Sub