James Snyder
Well-known Member
- Joined
- Jan 11, 2013
- Messages
- 618
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:
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.
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:
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 FunctionSince 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.
