Ark68
Well-known Member
- Joined
- Mar 23, 2004
- Messages
- 4,623
- Office Version
- 365
- 2016
- Platform
- 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:
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?
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