Problem With My Loop(s) Being Able To Match Data?

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
4,564
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I have yet found another problem with my code as I've advanced past by last problem. Consider the code below, specifically the code highlighted in blue. I'm not receiving an error, but I feel it's putting itself into an infinate loop, and in the process, failing to provide the results I'm trying to achieve.
This is what I am aiming to do:

  • Loop through each visible row of a filtered worksheet (For Each rw In filter_rng.SpecialCells(xlCellTypeVisible)) and obtain a value for the row (t=rw.row)
  • Assign string variable inqseg to the value in cell "t"5 of the filtered database. In testing, assume inqseg = "[02]"
  • Referring to a second worksheet (ws_form), obtain the value of flrow (flrow=Application.WorksheetFunction.Match("end", ws_form.Columns(8), 0) - 1) which is an integer representing the last row of a dataset that will be searched by this problematic code
  • A second nested loop starts searching the range in ws_form between rows 9 and the last row of the search range defined by flrow (For fdest = 9 To flrow). 'fdest' represents th value of the row targeted to check
  • 'fdest8' is a string variable which holds the value in cell "fdest",8 of worksheet ws_form. In testing, assume fdest8 = "[02]" and found in row 9 (fdest=9)
  • This should match, resulting then in cell "fdest",8 taking on a interior color format, and it's adjacent cell being applied a font format and being unlocked.

This is the issue. It is not finding a match in the search range despite one existing. The second loop searches the search range and fails, and then the first loop kicks in to find a macth for the next visible row's data, and it fails as well. This happens for all rows of visible data despite values existing in the search range of ws_form. Then, when all the rows from loop 1 have been evaluated, it seems to repeat itself. (I haven't really tested this runtime, just in testing by stepping through the code. I've observed that after the first round it appeared to start over.

Thoughts?

Rich (BB code):
Sub btn_subaccomplishment_Click()
    'Stop
    Dim datestamp As Date
    Dim filter_rng As Range
    Dim zn As String
    Dim visiblepp As Long, visiblecl As Long, visiblecw As Long
    Dim inqdate As String, inqempl As String, inqzn As String, inqcorr As String, inqtofind As String
    Dim lrow As Integer, y As Integer, zcount As Integer
    Dim rwend As Integer
    Dim rw As Range, t As Integer, inqseg As String, flrow As Integer, fdest As Integer, fdest8 As String
    Application.EnableEvents = False
    
    With ws_form  
        datestamp = Now
        .Unprotect
        .Range("O3").Value = "'" & emplnum
        .Range("O4").Value = eqtnum
        .Range("E8") = "+"
        .Range("E8").Interior.ColorIndex = xlNone
        .Range("F8") = "[00]"
        .Range("G8") = ""
        .Range("H8") = "[00-00]"
        .Range("H8").Interior.ColorIndex = xlNone
        .Range("J8") = ""
        .Range("E4") = datestamp
        .Range("E4").NumberFormat = "dd-mmm-yy"
        .Range("E4").Value = Date
        .Range("E6") = Format(datestamp, "h:mm am/pm")
        
        zn = .Range("O5")
        If ws_segments.AutoFilterMode = True Then ws_segments.AutoFilterMode = False
        With ws_segments.Range("A1")
            .AutoFilter Field:=2, Criteria1:=zn
            .AutoFilter Field:=7, Criteria1:="PP"
            visiblepp = Application.WorksheetFunction.Sum(ws_segments.Columns(8).SpecialCells(xlCellTypeVisible))
            .AutoFilter Field:=2, Criteria1:=zn
            .AutoFilter Field:=7, Criteria1:="CL"
            visiblecl = Application.Application.WorksheetFunction.Sum(ws_segments.Columns(8).SpecialCells(xlCellTypeVisible))
            .AutoFilter Field:=2, Criteria1:=zn
            '.AutoFilter field:=2, Criteria1:="CW", Operator:=xlOr, Criteria2:="MUT", Operator:=xlOr, Criteria3:="PX"
            .AutoFilter Field:=7, Criteria1:=Array("CW", "MUT", "PX"), Operator:=xlFilterValues
            visiblecw = Application.WorksheetFunction.Sum(ws_segments.Columns(8).SpecialCells(xlCellTypeVisible))
        End With
        If ws_segments.AutoFilterMode = True Then ws_segments.AutoFilterMode = False
        .Range("S4") = visiblecw
        .Range("S5") = 0
        .Range("U4") = visiblepp
        .Range("U5") = 0
        .Range("W4") = visiblecl
        .Range("W5") = 0
        
        clear_segments
        
        process_segments '{Process}
        rwend = Application.WorksheetFunction.Match("end", .Columns(8), 0)
        process_surfaceconditions
        process_operations
        
        'hide operations/surface
        .Unprotect
        .Rows(rwend + 1 & ":" & rwend + 16).Hidden = True
        .Shapes("btn_sendhome").Visible = False
        .Activate
        RemoveCellSelectionBox
        ActiveWindow.ScrollRow = 1 'the row you want to scroll to
        ActiveWindow.ScrollColumn = 1
        'Stop
' ------------------------------
        'Check if data already exists for ref
        'create ref to filter (date+employee number+zone+corridor+segment)
        Stop
        inqdate = Format(.Range("E4"), "00000")
        inqempl = Format(.Range("O3"), "00000")
        inqzn = .Range("O5")
        inqcorr = Mid(.Range("F8"), 2, 2)
        inqtofind = inqdate & inqempl & inqzn & inqcorr
        'Filter Data
        With ws_sdata
            If .AutoFilterMode = True Then .AutoFilterMode = False
            lrow = .Cells(.Rows.Count, "B").End(xlUp).Row
            Set filter_rng = .Range("A2:B" & lrow)
            filter_rng.AutoFilter Field:=2, Criteria1:=inqtofind & "*"
            For y = 3 To .Range("B2").CurrentRegion.Rows.Count
                If .Cells(y, 2).EntireRow.Hidden = False Then
                    zcount = zcount + 1
                End If
            Next y
        End With
        Stop
        If zcount = 0 Then 'filter has results
            .Protect
            Application.EnableEvents = True
            Exit Sub
        Else
            .Rows("9:" & rwend).Hidden = False
            With ws_data
                Set filter_rng = ws_sdata.Range("A3:B" & lrow)
                For Each rw In filter_rng.SpecialCells(xlCellTypeVisible)
                    t = rw.Row
                    inqseg = "[" & Format(ws_sdata.Cells(t, 5), "00") & "]"
                    flrow = Application.WorksheetFunction.Match("end", ws_form.Columns(8), 0) - 1
                    For fdest = 9 To flrow
                        fdest8 = ws_form.Cells(fdest, 8)
                        If fdest8 = inqseq Then
                            ws_form.Cells(fdest, 8).Interior.Color = ccgreen
                            ws_form.Cells(fdest, 6).Font.Color = ccgreen
                            ws_form.Cells(fdest, 6).Locked = False
                        End If
                    Next fdest
                Next rw
            End With
        End If

        'loop through filtered range and filling in selecting segment cells, unlocking colourized op cellc
        .Protect
    End With
    Application.EnableEvents = True
    
End Sub
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Disregard all. And thank you for everyone that may have wasted their time with this.
1st thing, subtle spelling mistake in one on the variables being compared.
Also added "Exit For" to the second look to exit that second loop once a value was found. No sense looking beyond the match.
 
Upvote 0
Hello Mr Excel & friends,
I continue to have an issue with the code in my OP, specifically the code highlighted in blue. There is (appears to be) something wrong with how the
Code:
For Each rw In filter_rng.SpecialCells(xlCellTypeVisible)
loop if functioning.

Replace the code highlighted in blue in my original post with this:
Rich (BB code):
           With ws_data
                'Set filter_rng = .Range("A3:B" & lrow)
                Set filter_rng = ws_sdata.Range("A3:B" & lrow)
                cntsel = 0
                For Each rw In filter_rng.SpecialCells(xlCellTypeVisible)
                    t = rw.Row
                    inqseg = "[" & Format(ws_sdata.Cells(t, 5), "00") & "]"
                    flrow = Application.WorksheetFunction.Match("end", ws_form.Columns(8), 0) - 1
                    For fdest = 9 To flrow
                        fdest8 = ws_form.Cells(fdest, 8)
                        If fdest8 = inqseg Then
                            segdist = ws_sdata.Cells(t, 8)
                            tsegdist = ws_form.Cells(8, 25).Value
                            ws_form.Cells(fdest, 8).Interior.Color = ccgreen
                            ws_form.Cells(fdest, 8).Font.Color = RGB(216, 216, 216)
                            ws_form.Cells(8, 25) = tsegdist + segdist
                            ws_form.Cells(fdest, 6).Font.Color = ccgreen
                            ws_form.Cells(fdest, 6).Locked = False
                            cntsel = cntsel + 1
                            Exit For
                        End If
                    Next fdest
                Next rw
            End With

When I step through this code with 3 rows of visible data, this loop duplicates for each row. For example, visible row, row 12 (t=12), is cycled through twice. Since really only the cells are formatted, there is no really consequence, other than the incremental counter cntsel gets one additional value added to it. So, when all three visible rows are looped through (each one twice), cntsel = 6 when it should equal 3.

Is anyone able to determine why each visible line is being processed twice?
 
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,849
Members
452,361
Latest member
d3ad3y3

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