[Solved] VBA: Quicker Loop ?

  • Hi All,


    I was hoping someone might have a quicker way of looping through a range?


    I use the following to loop through the cell value in D1:D251. If the value in the cell is greater than zero it does nothing, if less it hides the row and moves on to the next.


    Only problem is that it take yonks to loop through.......aggghhh people are way to impatient to wait 50 or 60 seconds.


    Suggestions?


    Range("D1:D251").Select
    Selection.EntireRow.Hidden = False
    Application.ScreenUpdating = True
    Range("D2").Select
    Do While Counter < 251
    Counter = Counter + 1
    If ActiveCell.value &gt; 0 Then
    ActiveCell.Offset(1, 0).Activate
    Else
    Selection.EntireRow.Hidden = True
    ActiveCell.Offset(1, 0).Activate
    End If
    Loop


    BTW: XL97 WIN98.


    Thanks


    AJW

  • try this
    Sub hideit()
    Dim I As Integer
    Range("D1:D251").Select
    Selection.EntireRow.Hidden = False
    For I = 0 To 251
    If ActiveSheet.[d1].Offset(I, 0).Value <= 0 Then
    ActiveSheet.[d1].Offset(I, 0).EntireRow.Hidden = True
    End If
    Next I
    End Sub


    Basically I reemoved all of the 'select' logic that causes Excel to repaint the screen and chew up a lot of resources.

  • Hi,


    Following procedure should please Your collegues when it comes to speed:


    Option Explicit


    Sub Hide_Rows_0()
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim rnData As Range
    Dim vaData As Variant
    Dim i As Long


    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets(1)


    With wsSheet
    Set rnData = .Range("D1:D255")
    End With


    vaData = rnData.Value


    For i = LBound(vaData) To UBound(vaData)
    If vaData(i, 1) < 0 Then rnData(i, 1).EntireRow.Hidden = True
    Next i


    End Sub

  • Hi AJW


    Try uisng Excel's AutoFilter. It's about the fastest way I know


    Code
    Sub HideThem()
        On Error Resume Next
        Sheet1.AutoFilterMode = False
        Range("D1:D2").AutoFilter
        Range("D1").AutoFilter Field:=1, Criteria1:="<>0"
        On Error GoTo 0
    End Sub


    OR, better still. Do the AutoFilter manually. Then go to View&gt;Custom&gt;Views click Add and name the view No Zeros Now run some code like below


    ActiveWorkbook.CustomViews("No Zeros").Show

  • Hi Dave,


    I agree that Autofilter is the fastest solution however it require that cell D1 holds a columnname which is not evaluated.


    In order to get this approach to work it require that the OP expand the range, D1:D256, and put a relevant name in cell D1.


    And it´s only valid as long as the Autofilter is on ;)


    Nevertheless, I like the second approach - cool :wink1:


    Kind regards,
    Dennis

  • Hi AJ,


    Dennis has offered you a good solution. All of the variables are explicitly declared and the data is transferred from a range to an array (where it will be quicker to process).


    An alternative, which should also be much quicker than the existing routine, would be to make use of the AutoFilter rather than doing any looping at all. EG

    HTH


    Edit: Oops - too slow ;;)

  • Thanks XLDennis, Richie, DaveH and Kieran for you EXCELent alternatives, appreciate the help. Am somewhat kicking myself though for not having thought through the alternatives.


    Allcare


    AJW

  • Back again, had a look at some of the alternatives offered. The Autofilter is not suitable as it seems to work on predefined views and values, unfortunately my views and values will vary with each new worksheet.


    I tried your solution XLDennis but it keeps bugging out on me here:


    If vaData(i, 1) < 0 Then



    Sub Hide_Rows_0()
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim rnData As Range
    Dim vaData As Variant
    Dim i As Long


    Set wbBook = ActiveWorkbook 'ThisWorkbook
    Set wsSheet = wbBook.ActiveSheet '.Worksheets(1)


    With wsSheet
    Set rnData = .Range("D1:D255")
    End With


    vaData = rnData.value


    For i = LBound(vaData) To UBound(vaData)
    If vaData(i, 1) < 0 Then rnData(i, 1).EntireRow.Hidden = True
    Next i
    End Sub



    I also tried to use your solution Kieran but it debugged out here:


    If ActiveSheet.[d1].Offset(I, 0).value <= 0 Then



    I'll have another look later when I get more time to see if I can tweek either to work.


    Thanks


    AJW

  • I had an other look at what I submitted.
    Basically is seemed to bomb where there was a text value in the range.


    try


    Sub hideit()
    Application.ScreenUpdating = False
    Dim I As Integer
    Dim rngIN As Range
    Dim rngStart As Range


    Set rngIN = Range("D1:D251")
    Set rngStart = rngIN.Cells(1, 1)
    rngIN.EntireRow.Hidden = False
    For I = 0 To rngIN.Rows.Count
    If IsNumeric(rngStart.Offset(I, 0).Value) Then
    If rngStart.Offset(I, 0).Value <= 0 Then
    rngStart.Offset(I, 0).EntireRow.Hidden = True
    End If
    End If
    Next I
    Application.ScreenUpdating = True
    End Sub



    I made a few more changes for speed (screen updating) and to reference the range a little better.

  • Kieran,


    Thanks, tried the new code and it works, only thing is it's not much quicker.


    Loop = 51.97 seconds.
    No Loop = 51.71 seconds.


    Thanks anyway, always interesting to consider alternatives.


    AJW

  • Are you saying the Autofilter method is taking 51 secs? If so try turning off Calculation:


    Application.Calculation = xlCalculationManual
    'CODE
    Application.Calculation = xlCalculationAutomatic

  • XLDennis !!!!!!!!!!!!! WINNER AND CHAMPION EXTRODINAIR.


    With a RECORD BREAKING performance of 10.64* seconds XLDennis code has shaved a whopping 41.07 seconds off the previous record held by LOOP.


    XLDennis stunned onlookers and officials with the clever use of the FOR / NEXT method in place of the LOOP.


    When interviewed later LOOP lamented his thrashing blaming screenupdating for his demise.


    *Record set on Pentium3, 800MHZ, 128MB RAM, XL97, WIN 98 config. Judges decision is final and no corespondence will be entered into. (but a bribe might change my mind). Precision timing recorded on a Quartz Digital $29.95 Lorus watch from Kmart - Water 50m Resist.


    (Imagine what people can do with all that spare time now) ;;)


    Modified code as follows:


    Sub hideit()
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim rnData As Range
    Dim vaData As Variant
    Dim I As Long


    'Set wbBook = ActiveWorkbook 'ThisWorkbook
    'Set wsSheet = wbBook.ActiveSheet '.Worksheets(1)
    Set wbBook = Application.ActiveWorkbook 'ThisWorkbook
    Set wsSheet = wbBook.Application.ActiveSheet '.Worksheets(1)


    With wsSheet
    'Set rnData = .Range("D1:D255")
    Set rnData = Application.Range("EquipSumQty")
    End With


    vaData = rnData.value


    For I = LBound(vaData) To UBound(vaData)
    'If vaData(I, 1) < 0 Then rnData(I, 1).EntireRow.Hidden = True
    If vaData(I, 1) < 1 Then rnData(I, 1).EntireRow.Hidden = True


    Next I
    End Sub


    Again thanks to everyone who responded, great to see so many varying methods and ideas.


    Allcare


    AJW

  • Quote

    Originally posted by Dave Hawley
    Out of curiosity, what were the time using the AutoFilter Method? I ask as I use this method frequently and it works on thousands of records in about 1-4 secs.


    Quote "Judges decision is final and no corespondence will be entered into. (but a bribe might change my mind). "


    Sorry Dave but it might upset the winner ;;)



    Only kidding, to be honest it was way faster, probably about 2 or 3 seconds but I didn't set things up for it to work the way the Autofilter seems to...... well my understanding of using it once.


    If time permits I'll play around with it to expand my knowledge but XLDennis's code was quicker to understand and solved my immediate problem of people thinking that their screen had frozen. Curse that Alt/Tab/Delete why are people so impatient ??


    Thanks


    AJW

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!