speeding up loop
Page 1 of 2 12 LastLast
Results 1 to 10 of 11

Thread: speeding up loop

  1. #1
    New Member
    Join Date
    Dec 2015
    Posts
    21
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Question speeding up loop

    Hi everyone

    I have a loop that is already working. I was just thinking if there is a way to select all the cells that is zero and deleting it at one go instead of sorting it using a loop 1 by 1 by vba. this have to be done in vba as this is just part of the code in a very long line of codes.

    the issue is because there are 3000 cells to evaluate. multiply that with 50 tabs that its cycling. that is a good 150,000 cells to check 1 by 1. the whole process takes me a few hours just to evaluate.

    Code:
    'delete empty rows
    Dim LastRow as long
    
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    For r = LastRow To 1 Step -1
    If Cells(r, 1) = 0 Then
    Rows(r).Delete
    End If
    Next r
    What this code does is that it will eliminate the zero values rows and consolidate all the known cells for further data manipulation.
    would be great if someone can point me in the right direction.

    Thanks heaps.

  2. #2
    Board Regular
    Join Date
    Sep 2016
    Posts
    2,560
    Post Thanks / Like
    Mentioned
    36 Post(s)
    Tagged
    1 Thread(s)

  3. #3
    Board Regular
    Join Date
    Oct 2009
    Location
    Midlands, UK
    Posts
    7,554
    Post Thanks / Like
    Mentioned
    18 Post(s)
    Tagged
    3 Thread(s)

    Default Re: speeding up loop

    This should be quicker. Ive set it to do every sheet in the workbook so be careful!

    Code:
    Dim sh As Worksheet, lastrow As Long, arr, i As Long, rng As Range
    
    For Each sh In ThisWorkbook.Worksheets
        With sh
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            If lastrow > 1 Then
                arr = .Range("A1:A" & lastrow)
                For i = LBound(arr) To UBound(arr)
                    If Not IsEmpty(arr(i, 1)) And arr(i, 1) = 0 Then
                        If Not rng Is Nothing Then
                            Set rng = Union(rng, .Range("A" & i))
                        Else
                            Set rng = .Range("A" & i)
                        End If
                    End If
                Next
                If Not rng Is Nothing Then rng.EntireRow.Delete Shift:=xlUp
                Erase arr
                Set rng = Nothing
            End If
        End With
    Next
    Looking for opportunities

  4. #4
    MrExcel MVP
    Moderator
    Peter_SSs's Avatar
    Join Date
    May 2005
    Location
    Macksville, Australia
    Posts
    40,401
    Post Thanks / Like
    Mentioned
    86 Post(s)
    Tagged
    19 Thread(s)

    Default Re: speeding up loop

    This should be even quicker. This one only acts on the active sheet though. I have assumed the sheet has a heading row. If not, please advise.
    If you want it extended to other sheets, is it all sheets in the workbook or just specific sheets?

    BTW, if it is to be applied to multiple tabs, do they all have the same number of columns of data? If so, what is the last column in each tab with data?

    Code:
    Sub Delete_Rows()
      Dim a As Variant, b As Variant
      Dim nc As Long, i As Long, k As Long
     
      nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
      a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
      ReDim b(1 To UBound(a), 1 To 1)
      For i = 1 To UBound(a)
        If a(i, 1) = 0 Then
          b(i, 1) = 1
          k = k + 1
        End If
      Next i
      If k > 0 Then
        Application.ScreenUpdating = False
        With Range("A2").Resize(UBound(a), nc)
          .Columns(nc).Value = b
          .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
          .Resize(k).EntireRow.Delete
        End With
        Application.ScreenUpdating = True
      End If
    End Sub
    Hope this helps, good luck.
    Peter
    Excel 365 - Windows 10
    - Want to help your helpers by posting a small, copyable, screen shot directly in your post? Look here
    - If posting vba code, please use Code Tags - like this [code]Paste code here[/code] - or use the VBHTML Maker
    - Read: Forum Rules, Forum Use Guidelines, & FAQ

  5. #5
    New Member
    Join Date
    Dec 2015
    Posts
    21
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: speeding up loop

    Thanks for the help. Thats very helpful. So basically the workbook have alot of sheets and each sheet have a unique name. there is a master sheet with raw data. all the sheets with unique names has exactly the same format. What i did was that i basically loop thru looking for empty values and then once its done i move on the the next sheet. in VBA i have the following:

    sub program()

    sheet 1()
    Sheet 2()

    end sub

    So it actually call each sheet and re run the codes over and over again thats all. all the sheets have formula that draws from a master sheet that have raw data. essentially, the master sheet data -> sheets data(sorter) and then i just sort of delete the rows for further data manipulation.

    If you have any idea how this can be further speed up, I'm definitely up for learning more!

    Thanks man!

  6. #6
    Board Regular Michael M's Avatar
    Join Date
    Oct 2005
    Location
    South Western NSW
    Posts
    17,677
    Post Thanks / Like
    Mentioned
    18 Post(s)
    Tagged
    2 Thread(s)

    Default Re: speeding up loop

    What about using

    Code:
    Sub MM1()
      With Range("A1", Cells(Rows.Count, "A").End(xlUp))
        .Replace 0, "#N/A", xlWhole, , False, , False, False
        Columns("A").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
      End With
    End Sub
    Regards
    Michael M
    ---------------------------------------
    The more I learn, the less I seem to know.....A Please and Thank You cost nothing !
    It's easier to debug if we can see the whole macro !
    Home 2007 & 2013

    - Posting guidelines, forum rules and terms of use

    - To download Mr Excel HTML Maker

    - Try searching for your answer first, see how

    - Read the FAQs

    - List of BB codes


    [CODE]Place Your Code Here[/CODE]

  7. #7
    New Member
    Join Date
    Dec 2015
    Posts
    21
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: speeding up loop

    Quote Originally Posted by Michael M View Post
    What about using

    Code:
    Sub MM1()
      With Range("A1", Cells(Rows.Count, "A").End(xlUp))
        .Replace 0, "#N/A", xlWhole, , False, , False, False
        Columns("A").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
      End With
    End Sub
    i think it works awesome for values. But My cells are all coded with formula like this. --> "=IF($I3<>$B$1,0,RawData!B2)"
    what this does is that it checks col I and try to match with Cell B1. if if the same it will show a value if not zero. maybe i could get it to show NA and then it will just delete accordingly. Let me play around with the col as well as the rest too.

    Edit: okay doesnt work with formula. let me think it thru how this should be done.

    Peter: Last col is till J all cols have formula build into it. its for specific sheets thou its like 50sheets out of 53 sheets etc. all sheets are identical with same col, forumla and pointing to master raw data. they just have different criteria to only display certain values base on which "company" thats all.

    steve and footoo: i need abit of time to try it out and update u guys. Thanks for the help! very interesting solutions.



    Thanks people!
    Last edited by Josephoo; Aug 25th, 2019 at 10:42 PM.

  8. #8
    Board Regular Michael M's Avatar
    Join Date
    Oct 2005
    Location
    South Western NSW
    Posts
    17,677
    Post Thanks / Like
    Mentioned
    18 Post(s)
    Tagged
    2 Thread(s)

    Default Re: speeding up loop

    Then, untested

    Code:
    Sub MM1()
      With Range("A1", Cells(Rows.Count, "A").End(xlUp))
        .Replace 0, "#N/A", xlWhole, , False, , False, False
        Columns("A").SpecialCells(xlformulas, xlErrors).EntireRow.Delete
      End With
    End Sub
    Regards
    Michael M
    ---------------------------------------
    The more I learn, the less I seem to know.....A Please and Thank You cost nothing !
    It's easier to debug if we can see the whole macro !
    Home 2007 & 2013

    - Posting guidelines, forum rules and terms of use

    - To download Mr Excel HTML Maker

    - Try searching for your answer first, see how

    - Read the FAQs

    - List of BB codes


    [CODE]Place Your Code Here[/CODE]

  9. #9
    MrExcel MVP
    Moderator
    Peter_SSs's Avatar
    Join Date
    May 2005
    Location
    Macksville, Australia
    Posts
    40,401
    Post Thanks / Like
    Mentioned
    86 Post(s)
    Tagged
    19 Thread(s)

    Default Re: speeding up loop

    Quote Originally Posted by Josephoo View Post
    Peter: Last col is till J all cols have formula build into it. its for specific sheets thou its like 50sheets out of 53 sheets etc. all sheets are identical with same col,
    OK, give this a try on a copy of your workbook.

    Code:
    Sub Delete_Rows_v2()
      Dim ws As Worksheet
      Dim a As Variant, b As Variant
      Dim nc As Long, i As Long, k As Long, AppCalc As Long
      
      AppCalc = Application.Calculation
      Application.Calculation = xlCalculationManual
      Application.ScreenUpdating = False
      nc = 11
      For Each ws In Worksheets
        Select Case ws.Name
          Case "Summary", "Report", "Special Cases" '<- List names of sheets you do NOT want processed
          
          Case Else '< This will do the following code on all other sheets
            k = 0
            With ws
              a = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Value
              ReDim b(1 To UBound(a), 1 To 1)
              For i = 1 To UBound(a)
                If a(i, 1) = 0 Then
                  b(i, 1) = 1
                  k = k + 1
                End If
              Next i
              If k > 0 Then
                With .Range("A2").Resize(UBound(a), nc)
                  .Columns(nc).Value = b
                  .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
                  .Resize(k).EntireRow.Delete
                End With
              End If
            End With
        End Select
      Next ws
      Application.Calculation = AppCalc
      Application.ScreenUpdating = True
    End Sub
    Last edited by Peter_SSs; Aug 25th, 2019 at 11:32 PM.
    Hope this helps, good luck.
    Peter
    Excel 365 - Windows 10
    - Want to help your helpers by posting a small, copyable, screen shot directly in your post? Look here
    - If posting vba code, please use Code Tags - like this [code]Paste code here[/code] - or use the VBHTML Maker
    - Read: Forum Rules, Forum Use Guidelines, & FAQ

  10. #10
    New Member
    Join Date
    Dec 2015
    Posts
    21
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: speeding up loop

    Quote Originally Posted by Peter_SSs View Post
    OK, give this a try on a copy of your workbook.

    Code:
    Sub Delete_Rows_v2()
      Dim ws As Worksheet
      Dim a As Variant, b As Variant
      Dim nc As Long, i As Long, k As Long, AppCalc As Long
      
      AppCalc = Application.Calculation
      Application.Calculation = xlCalculationManual
      Application.ScreenUpdating = False
      nc = 11
      For Each ws In Worksheets
        Select Case ws.Name
          Case "Summary", "Report", "Special Cases" '<- List names of sheets you do NOT want processed
          
          Case Else '< This will do the following code on all other sheets
            k = 0
            With ws
              a = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Value
              ReDim b(1 To UBound(a), 1 To 1)
              For i = 1 To UBound(a)
                If a(i, 1) = 0 Then
                  b(i, 1) = 1
                  k = k + 1
                End If
              Next i
              If k > 0 Then
                With .Range("A2").Resize(UBound(a), nc)
                  .Columns(nc).Value = b
                  .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
                  .Resize(k).EntireRow.Delete
                End With
              End If
            End With
        End Select
      Next ws
      Application.Calculation = AppCalc
      Application.ScreenUpdating = True
    End Sub
    Thank you sir! I think it works every fast and very well. managed to cut down my timing from 3hrs to 15mins. its very interesting how you implemented it.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •