spreadsheet goes into really long loop

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,352
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I have some code in my spreadsheet that needs to cycle through each item in a filtered list. Typically, there will be no more than 3 with the filtered list starting in A4

VBA Code:
        For Each ws In wb2.Worksheets
                If ws.Name <> "Cancellations" And ws.Name <> "Totals" And ws.Name <> "Sheet2" Then
                        With ws.[A3].CurrentRegion
                                'On Error Resume Next
                                'Autofilter the late cancel date enter in B37 with dates in column 1
                                .AutoFilter 1, LCDt
                                'Autofilter the late cancel request number with request numbers in column 3
                                .AutoFilter 3, LCReq
                                
                                'Check to see if the date cell, column A, for a job has anything in it. If it doesn't, turn the autofilter off and skip to the next sheet.
                                If ws.[A3].Cells.Offset(1, 0) = "" Then
                                    .AutoFilter
                                    SheetCounter = SheetCounter + 1
                                    'If SheetCounter = 12, none of the 12 monthly sheets have the entered date and request number so let the user know
                                    If SheetCounter = 12 Then
                                        MsgBox "A job with the date and request number entered does not exist"
                                    End If
                                    GoTo SkipNextSheet
                                End If
                                
                                'Check the count Autofilter
                                AutoFilterCounter = .Columns(1).SpecialCells(xlCellTypeVisible).Count
                                'If value less than 2, only the heading is visible so skip to the next sheet.
                                If AutoFilterCounter < 2 Then
                                    .AutoFilter
                                    'Add 1 to a sheet counter
                                    SheetCounter = SheetCounter + 1
                                    'If SheetCounter = 12, none of the 12 monthly sheets have the entered date and request number so let the user know
                                    If SheetCounter = 12 Then
                                        MsgBox "A job with the date and request number entered does not exist"
                                    End If
                                    GoTo SkipNextSheet
                                End If
                                
                                
                                Dim rng As Range, x As Range, answer As Integer
                                Set rng = ws.Range("A4:O7").SpecialCells(xlCellTypeVisible)
                                For Each x In rng
                                    answer = MsgBox("Is this the job you want to apply the late cancel price too?", vbQuestion + vbYesNo + vbDefaultButton2, "Late Cancel Price")
                                Next x


The last section of code is the bit I have recently added. I have 2 entries in one of my sheets that match the autofilter for LCDt and LCReq so I would imagine that I would get the message box twice but it asks me 59 times. Can someone tell me what I have done wrong please?
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Noting the size of the range used, you are going to get 15 message boxes for each visible row (1 for each column). I would suggest only applying that section to a single column to reduce the number of message boxes.
 
Upvote 0
What's wrong with this code Jason? I tried to adjust it a little to see if there is more than 1 result. I can't actually remember why I started to try and work that out but my syntax is wrong anyway.

VBA Code:
                                If ws.Range("A4", ws.Range("A4").End(xlDown)) > 1 Then
                                    Dim rng As Range, x As Range, answer As Integer
                                    Set rng = ws.Range("A4:A7").SpecialCells(xlCellTypeVisible)
                                    For Each x In rng
                                        answer = MsgBox("Is this the job you want to apply the late cancel price too?", vbQuestion + vbYesNo + vbDefaultButton2, "Late Cancel Price")
                                    Next x
                                End If

I get an error type mismatch with the following line highlighted

VBA Code:
If ws.Range("A4", ws.Range("A4").End(xlDown)) > 1 Then
 
Upvote 0
Not sure exactly how you would set correct syntax in that method, but something like this would be closer.
VBA Code:
If ws.Range("A4", ws.Range("A4").End(xlDown)).Rows.Count > 1 Then
Personally, I prefer the method of getting row number and working up instead of down.
VBA Code:
Dim lRow As Long
lRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
If lRow > 4 Then
Although I should point out that both methods will be counting actual rows, not visible rows.

Going back to the original question and looking at what you might be doing rather than how you're trying to do it, something I would consider would be to
VBA Code:
For Each x In rng
        answer = MsgBox(x.Value & vbCrlf & vbCrlf & "Is this the job you want to apply the late cancel price too?", vbQuestion + vbYesNo + vbDefaultButton2, "Late Cancel Price")
Nextx
Using a column that contains an identifier such as a job name or number for rng and adding that identifier to the message box each time for user clarity.

I'm done for the day (midnight UK time), will check in the morning to see how this is progressing.
 
Upvote 0

Forum statistics

Threads
1,213,482
Messages
6,113,913
Members
448,532
Latest member
9Kimo3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top