View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
joel joel is offline
external usenet poster
 
Posts: 9,101
Default .Find method with numeric and date values, Aug2009

I modified the code the way microsoft would write the code. You didn't
specify lookin:=values and lookat:=xlwhole. I removed an unecessay IF
statement in the loop and changed "Loop until" to "loop while", and added a
NOT.

Sub FindRngValues(InRng As Range, vFind, DupeRng As Range, lCellCount As
Long, _
Optional Found1Rng As Range = Nothing, Optional bWhole As Boolean = True, _
Optional AfterRng As Range = Nothing, Optional LookIn As Integer =
xlValues, _
Optional bOneRng As Boolean = False, Optional iAreas As Integer = 0)

'Return data ranges containing vFind.
' DupeRng is nothing on not found or no dupes.
' lCellCount = count of cells in DupeRng.
' iAreas = count of areas in DupeRng.
' Found1Rng, not nothing has 1st find. DupeRng contains the ADDITIONAL
duplicate values.
' bWhole T= xlWhole F= xlPart,
' To NOT use top left of InRng as After parm, value input AfterRng arg with
1 cell.
' LookIn xlValues or xlFormulas
' bOneRng, F=Dupe and Found1 ranges, iAreas as defined above. T= DupeRng
contains Found1Rng,
' iAreas and lCellCount are for the union'd DupeRng.

Dim Rng As Range
Dim FirAdr As String
Dim LookAt As Integer 'xlwhole or xlpart

'mainline start
Set DupeRng = Nothing
iAreas = 0
lCellCount = 0
Set Found1Rng = Nothing
If InRng Is Nothing Then Exit Sub
If VarType(vFind) = vbString Then If vFind = "" Then Exit Sub
If bWhole Then LookAt = xlWhole Else LookAt = xlPart

With InRng
If AfterRng Is Nothing Then
Set Rng = .Find(what:=vFind, LookIn:=xlvalues, LookAt:=xlwhole)
Else
Set Rng = .Find(what:=vFind, after:=AfterRng, LookIn:=xlvalues,
LookAt:=xlvalues)
End If

If Not Rng Is Nothing Then

Set Found1Rng = Rng
FirAdr = Found1Rng.Address

Do
Set Rng = .FindNext(after:=Rng)
lCellCount = lCellCount + 1
If lCellCount = 1 Then
Set DupeRng = Rng
Else
Set DupeRng = Union(DupeRng, Rng)
End If
End If
Loop while not Rng Is Nothing Or Rng.Address = FirAdr
End If
End With


If Not Found1Rng Is Nothing And bOneRng Then
If DupeRng Is Nothing Then
Set DupeRng = Found1Rng
lCellCount = 1
Else
Set DupeRng = Union(Found1Rng, DupeRng)
lCellCount = lCellCount + 1
End If
End If

If Not DupeRng Is Nothing Then iAreas = DupeRng.Areas.Count
'mainline end
End Sub


"Neal Zimm" wrote:

Hi -
I built the proc below as a tool using the .Find
method. I'm testing it.

It works OK when vFind is loaded with a string or an integer number.

It does NOT find numeric values such as 1401.61 or any

date values. The Mso help on .Find says "any data type"

for the variant find argument.

Examples prior to calling FindRngValues

Dim DtTest as date
Dim nValue as single
Dim vFind as variant


nvalue = range(whatever).value '1300.00 (cell format number, 2 decimals)
vFind = nvalue
Call .... ' values were found.

nvalue = range(whatever).value '1401.61 (cell format number, 2 decimals)
vFind = nvalue
Call .... ' values were NOT found, but I see them in the worksheet cells.

Same for DtTest values where cell formatted as date, "m/d/yyyy"
Cell values were not found.

What can I do to find these types of data ? (I have row loops that work,
but I like the flexibility of proc below)

Thanks,
Neal Z.



Sub FindRngValues(InRng As Range, vFind, DupeRng As Range, lCellCount As
Long, _
Optional Found1Rng As Range = Nothing, Optional bWhole As Boolean = True, _
Optional AfterRng As Range = Nothing, Optional LookIn As Integer =
xlValues, _
Optional bOneRng As Boolean = False, Optional iAreas As Integer = 0)

'Return data ranges containing vFind.
' DupeRng is nothing on not found or no dupes.
' lCellCount = count of cells in DupeRng.
' iAreas = count of areas in DupeRng.
' Found1Rng, not nothing has 1st find. DupeRng contains the ADDITIONAL
duplicate values.
' bWhole T= xlWhole F= xlPart,
' To NOT use top left of InRng as After parm, value input AfterRng arg with
1 cell.
' LookIn xlValues or xlFormulas
' bOneRng, F=Dupe and Found1 ranges, iAreas as defined above. T= DupeRng
contains Found1Rng,
' iAreas and lCellCount are for the union'd DupeRng.

Dim Rng As Range
Dim FirAdr As String
Dim LookAt As Integer 'xlwhole or xlpart

'mainline start
Set DupeRng = Nothing
iAreas = 0
lCellCount = 0
Set Found1Rng = Nothing
If InRng Is Nothing Then Exit Sub
If VarType(vFind) = vbString Then If vFind = "" Then Exit Sub
If bWhole Then LookAt = xlWhole Else LookAt = xlPart

With InRng
If AfterRng Is Nothing Then
Set Rng = .Find(vFind, , LookIn, LookAt)
Else
Set Rng = .Find(vFind, AfterRng, LookIn, LookAt)
End If

If Not Rng Is Nothing Then

Set Found1Rng = Rng
FirAdr = Found1Rng.Address

Do
Set Rng = .FindNext(Rng)
If Not Rng Is Nothing And Rng.Address < FirAdr Then
lCellCount = lCellCount + 1
If lCellCount = 1 Then
Set DupeRng = Rng
Else
Set DupeRng = Union(DupeRng, Rng)
End If
End If
Loop Until Rng Is Nothing Or Rng.Address = FirAdr
End If
End With


If Not Found1Rng Is Nothing And bOneRng Then
If DupeRng Is Nothing Then
Set DupeRng = Found1Rng
lCellCount = 1
Else
Set DupeRng = Union(Found1Rng, DupeRng)
lCellCount = lCellCount + 1
End If
End If

If Not DupeRng Is Nothing Then iAreas = DupeRng.Areas.Count
'mainline end
End Sub
--
Neal Z