Bug in my code

[kirkm]

I've modified this Find routine somewhat to return
an array of line numbers where Columns G & F match string ta.

I thought it was working perfectly - until it failed, and I can't see
where or how.

For my test I entered "ColF" into $F$6, $F$83, $F$160, $F$239, $F$319
and "ColG" into $G$6, $G$83, $G$160, $G$239, $G$319
into Sheet "Formats".

The function is :-

--
Function GetLines(mSheet, ta, ByVal fromLine)
'Returns Array of line numbers in mSheet where Cols G + F = ta.
Starting from fromline
Dim Rng As Range
Dim Quit As Boolean
ReDim nums(0) As Variant
Dim lastfound, fl
Dim iRow As Long, LastRow
With Worksheets(mSheet)
Set Rng =
Worksheets(mSheet).Range("A1").SpecialCells(xlCellTypeLastCell)
LastRow = Rng.row
While Quit = False
On Error Resume Next
iRow = .Evaluate("Match(" & Chr$(34) & ta & Chr$(34) & ", G" &
fromLine & ":G" & LastRow & "&F" & fromLine & ":F" & LastRow & ", 0)")
On Error GoTo 0
If iRow = lastfound Then
Quit = True
Else
lastfound = iRow
If iRow > 0 Then
ReDim Preserve nums(UBound(nums) + 1)
fl = iRow + (fromLine - 1)
nums(UBound(nums)) = fl
End If
End If
fromLine = fl + 1
Wend
End With
Set Rng = Nothing
GetLines = nums
Erase nums
End Function
--

If I call this with :-

Sub testget()
Dim ta, f, TheLines
ta = "ColGColF": f = 6
TheLines = GetLines("Formats", ta, f)
For f = 1 To UBound(TheLines)
Debug.Print TheLines(f)
Next
End Sub

and I see
6
83

But increasing f to an 8 does return the correct 4 line numbers

83
160
239
319

I hope someone might see why using 6 only returns 2 of what should be
5.

Many thanks - Kirk. Apologies if this is a bit long-winded.

 

[Per Jessen]

Hi

This is not the entire solution, but as the first element in an array
has number 0 unless Option Base 1 is used, you should use:

For f = 0 to UBound(TheLines)

Hopes it helps.

Regards,
Per

 

[John Bundy]

Ok, it took a bit to figure out what you were doing, but i got it. You just
happened to be extremely lucky(unlucky) in your choice of columns for
testing. The reason for the failure is that you are stopping it if
iRow=Lastfound, which coincidentally occurs when you don't want it to. 6 and
83 are 77 apart, 83 and 160 is also 77 apart so the routine ends there. I
commented out that piece below and added a line that says if the fromLine is
ever higher than the lastRow then quit.

Function GetLines(msheet, ta, ByVal fromLine)
'Returns Array of line numbers in mSheet where Cols G + F = ta.Starting from
fromline
Dim Rng As Range
Dim Quit As Boolean
ReDim nums(0) As Variant
Dim lastfound, fl
Dim iRow As Long, LastRow
With Worksheets(msheet)
Set Rng = Worksheets(msheet).Range("A1").SpecialCells(xlCellTypeLastCell)
LastRow = Rng.Row
While Quit = False
On Error Resume Next
'MsgBox "Match(" & Chr$(34) & ta & Chr$(34) & ", G" & fromLine &
":G" & LastRow & "&F" & fromLine & ":F" & LastRow & ", 0)"
iRow = .Evaluate("Match(" & Chr$(34) & ta & Chr$(34) & ", G" &
fromLine & ":G" & LastRow & "&F" & fromLine & ":F" & LastRow & ", 0)")

On Error GoTo 0
' If iRow = lastfound Then
' Quit = True
' Else
lastfound = iRow
If iRow > 0 Then
ReDim Preserve nums(UBound(nums) + 1)
fl = iRow + (fromLine - 1)
nums(UBound(nums)) = fl
End If
'End If
fromLine = fl + 1
If fromLine > LastRow Then Quit = True
Wend

End With
Set Rng = Nothing
GetLines = nums
Erase nums
End Function


Sub testget()
Dim ta, f, TheLines
ta = "ColGColF": f = 1
TheLines = GetLines("Sheet1", ta, f)
For f = 1 To UBound(TheLines)
mystring = mystring & TheLines(f) & vbCrLf
Next
MsgBox mystring
End Sub

 

[kirkm]

Ok, it took a bit to figure out what you were doing, but i got it. You just
happened to be extremely lucky(unlucky) in your choice of columns for
testing. The reason for the failure is that you are stopping it if
iRow=Lastfound, which coincidentally occurs when you don't want it to. 6 and
83 are 77 apart, 83 and 160 is also 77 apart so the routine ends there. I
commented out that piece below and added a line that says if the fromLine is
ever higher than the lastRow then quit.

Hi John,

Brilliant, sanity restored and I can see the problem and why is isn't
always a problem!

So iRow repeats the last value for no match found.. which may
sometimes be the next number. I wonder how you detect a real no
match?

Drawing board out again... many thanks for the help.

Cheers - kirk

 

[kirkm]

Hi

This is not the entire solution, but as the first element in an array
has number 0 unless Option Base 1 is used, you should use:

Thanks Per, I'll remember that. I may have Base 1 set without
realising... element (1) seems to always be the first.

Cheers - Kirk

 

[keiji kounoike]

Your Evaluate part is hard to read for me. so, I rewrite your code. note
that array nums start from nums(0) in my code.

Function GetLines(mSheet, ta, ByVal fromLine)
Dim Rng As Range
Dim nums() As Long
Dim Lastrow As Long, co As Long
Dim iRow As Variant
Dim arr As Variant

Set Rng = Worksheets(mSheet).Range("A1") _
.SpecialCells(xlCellTypeLastCell)
Lastrow = Rng.Row
ReDim nums(Lastrow)
Do While fromLine < Lastrow
arr = Evaluate("F" & fromLine & ":F" & Lastrow & "&" _
& "G" & fromLine & ":G" & Lastrow)
iRow = Application.Match(ta, arr, 0)
If IsError(iRow) Then
Exit Do
End If
nums(co) = iRow + (fromLine - 1)
fromLine = nums(co) + 1
co = co + 1
Loop
If co > 0 Then
ReDim Preserve nums(co - 1)
Else
ReDim Preserve nums(co)
End If
GetLines = nums
End Function

keiji