Find next problem

[Jan Eric Nilsson]

Search a range (column) for an items first apperance and last
apperance, the range is sorted.
There are roughly 100 unique items in the column, the column consits
of roughly 20 000 rows.
But if a given items passes row 99 or 999 or 9999 the code gives
answer that the end is these figures, even if the true range is from
row 85 to 115 etc. Why....?

......

Dim rngToSearch As Range
Dim rngFound As Range
Dim rngFoundAll As Range
Dim strFirst As String
Dim senaste As String
Dim slut As Integer
Dim först As Integer

Set rngToSearch = Worksheets("Basefile").Range("B2:B" & sista)

söka = cellg.Value ' find range that contains this item


Set rngFound = rngToSearch.Find(What:=söka, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
MatchCase:=False)
If Not rngFound Is Nothing Then
Set rngFoundAll = rngFound
strFirst = rngFound.Address
senaste= strFirst
Do
Set rngFoundAll = Union(rngFound, rngFoundAll)
Set rngFound = rngToSearch.FindNext(rngFound)
strlast = rngFound.Address
If Right(strlast, Len(strlast) - 3) > Right(strFirst, Len
(strFirst) - 3) Then
senaste= strlast
End If
Loop Until rngFound.Address = strFirst

MsgBox strFirst & vbLf & vbLf & senaste ' will give the rows
to copy

End If

Hope for support...

BR

Jan Eric

 

[Per Jessen]

Hi Jan Eric,

I think this is what you need. Notice I added an "after" property to
the find statement.

Dim rngToSearch As Range
Dim rngFound As Range
Dim rngFoundAll As Range
Dim strFirst As String
Dim strLast As String
Dim senaste As String
Dim slut As Integer
Dim först As Integer

Set rngToSearch = Worksheets("Basefile").Range("B2:B" & sista)
Set LastCell = Worksheets("Basefile").Range("B" & sista)
söka = cellg.Value ' find range that contains this item
Set rngFound = rngToSearch.Find(What:=söka, _
After:=LastCell, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
MatchCase:=False)
If Not rngFound Is Nothing Then
Set rngFoundFirst = rngFound
Set rngFoundAll = rngFound
Do
Set rngFoundAll = Union(rngFound, rngFoundAll)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = rngFoundFirst.Address
MsgBox rngFirstFound.Row & vbLf & vbLf & rngFound.Row
'will give the rows to copy
End If

Regards,
Per