.FindNext not working inside Autofiltered data after .Find works

[James Snyder]

Everyone has the desire to learn while doing tedious projects, and this is one of my learning 'splurges'. I am using Excel 2010, the code is all in the same default macro module, and I know that I can loop instead of using the .Find/.Findnext functions.

I am working on handling NULL fields in a column of meter readings. A duplicate will be OK if the meter was either obstructed or the gas company beat us to the work, so I am doing validation of the NULL fields returned using Autofilter. Since the combinations of work order items all get handled differently, this code is working only on the work order item of "Back Office".

My problem is defined as this: I am searching with the .Find for the unique identifier of the NULL meter reading on the current row exposed by a For Each on the filtered range. The .FindNext should return the next duplicate unique identifier, but is stuck on the original row even though there are other rows with that identifier.

Although MS help files are sparse and somewhat misleading, this problem has been hashed thoroughly in the forums and I have been playing with the code and researching for several days. WIthout further ado, the problem chunk of code:

Private Function HandleNullReads(ByRef woWkBk As Workbook, _
    ByRef ftpWkBk As Workbook, _
    ByVal endColumn As Long, _
    ByVal mReadColumn As Long, _
    ByVal itemColumn As String, _
    ByVal cmntColumn As String, _
    ByVal psidColumn As String, _
    ByVal obstColumn As String, _
    ByVal mmoColumn As String, _
    ByRef exceptArray() As String, _
    ByRef sendDate As String, _
    ByVal errorSrc As String) As String
    
    Dim woWkSht As Worksheet
    Dim ftpWkSht As Worksheet
    Dim dataRange As Range
    Dim filteredRange As Range
    Dim currentRow As Range
    Dim startRow As String
    Dim thisRow As String
    Dim rowMax As Long
    Dim findRange As Range
    Dim findValue As Range
    Dim failReturn As String
    Dim errString As String
    
    ' Up front prep
    If Not ftpWkBk Is Nothing Then
        Set ftpWkSht = ftpWkBk.Sheets(1)
        If ftpWkSht Is Nothing Then
            errString = errorSrc & "Failed to open 2nd worksheet to handle NULLs"
            failReturn = ProblemReport(errString, sendDate)
            Err.Clear
            HandleNullReads = errString
            GoTo NULLEnd
        End If
    Else
        errString = errorSrc & "Failed to open 2nd workbook to handle NULLs"
        failReturn = ProblemReport(errString, sendDate)
        Err.Clear
        HandleNullReads = errString
        GoTo NULLEnd
    End If
    
    ' AutoFilter used to get only NULL meter reads
    If Not woWkBk Is Nothing Then
        Set woWkSht = woWkBk.Sheets(1)
        If Not woWkSht Is Nothing Then
            rowMax = woWkSht.Range("A65535").End(xlUp).Row  ' Assign last row
            
            ' Sort by Item No. then by PSID
            woWkSht.Range("A2:F" & rowMax).Sort _
                key1:=woWkSht.Range("B2"), _
                key2:=woWkSht.Range("A2")
            With woWkSht
                Set dataRange = .Range(.Cells(1, 1), .Cells(.Rows.count, endColumn).End(xlUp))
                
                With dataRange
                    .AutoFilter Field:=mReadColumn, Criteria1:=vbNullString ' or "="
                    Set filteredRange = .Offset(1, 0).Resize(.Rows.count - 1, 1) _
                        .Cells.SpecialCells(xlCellTypeVisible)
                        
                    If Not filteredRange Is Nothing Then
                    With filteredRange
                        For Each currentRow In filteredRange
                        
                            ' Handle each work order item differently
                            Select Case .Range(itemColumn & currentRow.Row).Value
                                
                                Case "Back Office"   [COLOR=#ff0000][B]<===== THIS CASE[/B][/COLOR]
                                    ' .Find from the filtered list a PSID with either a CG or an Obstructed
                                    With dataRange.Range(psidColumn & "2:" & psidColumn & rowMax)
                                        Set findValue = .Columns(psidColumn)[COLOR=#ff0000][B].Find[/B][/COLOR](What:=currentRow, _
                                            LookIn:=xlValues, SearchDirection:=xlNext)
                                        If Not findValue Is Nothing Then
                                            startRow = findValue.Row
                                        End If
                                    End With
                                        
                                    ' Check FTP file for matching PSID, then check for CG or Obstructed
                                    If IsEmpty(findValue.Value) Then
                                        failReturn = WriteException(currentRow.Range(psidColumn & currentRow.Row).Value, _
                                            exceptArray, sendDate)
                                    Else
                                        
Debug.Print findValue.Offset(0, 1).Value
                                            
                                        [COLOR=#008000][B]Do[/B][/COLOR]
                                            If Not (findValue.Offset(0, 1).Value = "Columbia Gas" Or _
                                                findValue.Offset(0, 1).Value = "Obstructed Meter") Then
                                                Set findValue = [COLOR=#ff0000][B].FindNext[/B][/COLOR](After:=findValue)  [COLOR=#ff0000][B]<==== NO NEXT INSTANCE[/B][/COLOR]
                                                thisRow = findValue.Row
                                        
Debug.Print thisRow
                                            
                                            Else
                                                Exit Do ' OK to have no meter reading for CG or Obstructed
                                            End If
                                        [B][COLOR=#008000]Loop While[/COLOR][/B] Not findValue Is Nothing And [B][COLOR=#0000ff]startRow <> findValue.Row[/COLOR][/B]
                                        
                                        If startRow = findValue.Address Then    ' Match not found - error
                                            failReturn = WriteException(currentRow.Range(psidColumn & currentRow.Row).Value, _
                                                exceptArray, sendDate)
                                        End If
                                    End If
                                    
                                Case "Columbia Gas"
                                    ' Check for comments in FTP file
                                    Set findValue = ftpWkSht.Columns(psidColumn) _
                                        .Find(currentRow.Range(psidColumn & currentRow.Row).Value)
                                    If IsEmpty(findValue.Value) Then
                                    Else
                                        If Not findValue.Range(cmntColumn & currentRow.Row).Value Then
                                        Else
                                        End If
                                    End If
                                    
                                Case "Inspection Completed"
                                    ' Do not send - add to exceptions only
                                    ReDim Preserve exceptArray(UBound(exceptArray) + 1)   ' Adjust array size up by one row
                                    exceptArray(UBound(exceptArray)) = currentRow.Range(psidColumn & currentRow.Row).Value
                                    
                                Case "Meter Moved Outside"
                                    ' Code here...check for selected MMO code
                                    Set findValue = ftpWkSht.Columns(psidColumn) _
                                        .Find(currentRow.Range(psidColumn & currentRow.Row).Value)
                                        
                                    ' Check FTP file for matching PSID, then check for CG or Obstructed
                                    If IsEmpty(findValue.Value) Then
                                        ReDim Preserve exceptArray(UBound(exceptArray) + 1)   ' Adjust array size up by one row
                                        exceptArray(UBound(exceptArray)) = currentRow.Range(psidColumn & currentRow.Row).Value
                                    Else
                                        If Not findValue.Range(mmoColumn & currentRow.Row).Value Then
                                        Else
                                        End If
                                    End If
                                    
                                Case "Obstructed Meter"
                                    ' Code here...check for selected Meter Obstructed Code
                                    Set findValue = ftpWkSht.Columns(psidColumn) _
                                        .Find(currentRow.Range(psidColumn & currentRow.Row).Value)
                                        
                                    ' Check FTP file for matching PSID, then check for CG or Obstructed
                                    If IsEmpty(findValue.Value) Then
                                        failReturn = WriteException(currentRow.Range(psidColumn & currentRow.Row).Value, _
                                            exceptArray, sendDate)
                                    Else
                                        If Not findValue.Range(obstColumn & currentRow.Row).Value Then
                                        Else
                                        End If
                                    End If
                                    
                                Case Else
                                    ' Cough up a hairball
                                
                            End Select
                            
                            
                            ' Five main situations: _
                              first is Columbia Gas or Obstructed Meter missing comments (Add) _
                              second is Columbia Gas or Obstructed meter with comments (Send) _
                              third is Back Office without CG or Obst (Add) _
                              fourth is Meter Moved Outside without comments (Add) _
                              fifth is Completed Inspection without or without comments (Add)
'                            If Not (currentRow.Range(mReadColumn, currentRow.Row).Value = "Columbia Gas Completed" And _
'                                Not currentRow.Range(mReadColumn, currentRow.Row).Value = "Obstructed Meter") Or _
'                                ((currentRow.Range(mReadColumn, currentRow.Row).Value = "Columbia Gas Completed" Or _
'                                currentRow.Range(mReadColumn, currentRow.Row).Value = "Obstructed Meter") And _
'                                IsEmpty(currentRow.Range(cmntColumn, currentRow.Row).Value)) Then
                                
'Debug.Print currentRow.Range(mReadColumn, currentRow.Row).Value
Debug.Print currentRow.Range(cmntColumn, currentRow.Row).Value

                                ' Adjust array to hold another row and assign value
                                ReDim Preserve exceptArray(UBound(exceptArray) + 1)   ' Adjust array size up by one row
                                exceptArray(UBound(exceptArray)) = currentRow   ' Record in array
    
                                ' Once entered into array, write to Exceptions file
                                errString = exceptArray(UBound(exceptArray)) _
                                    & "              " & errorSrc & " NULL Meter Reading"
                                failReturn = ProblemReport(errString, sendDate)
'                            End If
                        Next currentRow
                        
                        ' Delete the range of NULL meter readings
                        On Error Resume Next
                        Application.DisplayAlerts = False       ' Suppress "Delete" dialog box
                        Application.EnableEvents = False        ' Suppress BeforeDelete event
                        .Delete ' Delete all rows with a NULL meter reading
                        Application.EnableEvents = True
                        Application.DisplayAlerts = True
                        On Error GoTo 0
                    End With    ' filteredRange
                    Else
                        If ActiveSheet.AutoFilterMode Then
                            On Error Resume Next
                            woWkSht.ShowAllData    ' No NULL meter readings - inactivate all filters
                            On Error GoTo 0
                        End If
                    End If

                    .AutoFilter Field:=mReadColumn ' turn off filter
                End With    ' dataRange
            End With    ' woWkSht
            
            Application.DisplayAlerts = False       ' Suppress "SaveAs" dialog box
            Application.EnableEvents = False        ' Suppress BeforeSave event
            woWkBk.Save
            Application.EnableEvents = True
            Application.DisplayAlerts = True
            HandleNullReads = "Success"
        Else
            errString = errorSrc & "Failed to open worksheet to remove NULLs"
            failReturn = ProblemReport(errString, sendDate)
            Err.Clear
            HandleNullReads = errString
        End If
    Else
        errString = errorSrc & "Failed to open workbook to remove NULLs"
        failReturn = ProblemReport(errString, sendDate)
        Err.Clear
        HandleNullReads = errString
    End If
NULLEnd:
    woWkSht.AutoFilterMode = False
End Function

Since the .FindNext fails to return a new value, the loop stops after a single pass and does nothing for me. This is not in a UDF (common cause) or being called from a cell (another common cause), and I haven't a clue at this point.

 

[Jerry Sullivan]

Hi James,

The problem is the With block references - it appears you could be mixing references to With Objects with worksheet Addresses.

The Range.Range property allows you to reference ranges relative to other ranges,
similar to the Range.Offset property, or Range.Cells(row,col)

When the base range begins at A1, the resulting Range.Range reference is the same as if it were a Worksheet.Range reference...

Sub Test()
    With Range("A1:D10")
        Debug.Print .Columns("C").Address '--Returns "$C$1:$C$10"
    End With
End Sub

When the base range is not A1, the resulting Range.Range reference is offset from the similar Worksheet.Range reference.

Sub Test2()
    With Range("P1:Z10")
        Debug.Print .Columns("C").Address '--Returns "$R$1:$R$10"
    End With
End Sub

If we excerpt the parts of your code that affect the .Find and .FindNext ranges we can see how the concept in the examples could lead to unexpected results.

Sub Test3()
'--Assume filteredRange is some visible cells in Column A, psidColumn="C", rowMax=10

    
    With filteredRange  '--$A$3,$A$4,$A$6,$A$8

        With dataRange.Range(psidColumn & "2:" & psidColumn & rowMax) '-- $C$2:$C$10
             Set findValue = .Columns(psidColumn)  _                                  '--"$F$2:$F$10"
                  .Find(What:=currentRow) 
        End With

        Set findValue = .FindNext(After:=findValue) '-- FindRange is=  '--$A$3,$A$4,$A$6,$A$8

   End With

End Sub

This shows that specific problem with FindNext is that it is not referencing the same Range as the .Find call. (unless psidColumn="A")
But in addition to fixing that, you should revisit the other Range.Range references since they might not be doing what you intended.

 

[Jerry Sullivan]

One clarification: The last example code assumes mReadColumn=1 which aligns the left column of dataRange and filteredRange.

That might not be your case, but the same principle will apply - a lot of moving parts!

 

[James Snyder]

The problem is the With block references - it appears you could be mixing references to With Objects with worksheet Addresses.

Sub Test3()
    With filteredRange  

        With [B][COLOR=#ff0000]dataRange[/COLOR][/B].Range(psidColumn & "2:" & psidColumn & rowMax) 
             Set findValue = .Columns(psidColumn)  _                                 
                  .Find(What:=currentRow) 
        End With

        Set findValue = .FindNext(After:=findValue) 

   End With

End Sub

This shows that specific problem with FindNext is that it is not referencing the same Range as the .Find call. (unless psidColumn="A")

Right you are, and thanks. By removing the dataRange object reference, everything is looking at the filtered data. Since the sought record field has to also be in the filteredRange, that is intuitive once I saw it. I will get back to the code this afternoon and check out the rest of your suggestions. Meanwhile, back to getting the process done manually this morning!