Hi Bradley

This runs like lightning. I would change the cell you want to use as
your criteria to be a variable then its all down hill.

Take care

Marcus

Sub findit()
'Make 123456 a variable
Find_Range(123456, Columns("B"), xlFormulas, xlWhole). _
EntireRow.Copy Range("Sheet2!B65536").End(xlUp).Offset(1, 0).EntireRow
End Sub


Function Find_Range(Find_Item As Variant, _
Search_Range As Range, _
Optional LookIn As Variant, Optional LookAt As Variant, _
Optional MatchCase As Boolean) As Range
Dim c As Range

If IsMissing(LookIn) Then LookIn = xlValues 'xlFormulas
If IsMissing(LookAt) Then LookAt = xlPart 'xlWhole
If IsMissing(MatchCase) Then MatchCase = False

With Search_Range
Set c = .Find(What:=Find_Item, LookIn:=LookIn, _
LookAt:=LookAt, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=MatchCase, _
SearchFormat:=False)
If Not c Is Nothing Then
Set Find_Range = c
firstAddress = c.Address
Do
Set Find_Range = Union(Find_Range, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With

End Function

I'm afraid I have a stupid question. How do I set up the cell with the
client ID# (in my example, 123456) as a variable? Will your suggestion work
if I have thousands of different client ID#s?

Thanks--sorry for getting back so late after your reply.


"marcus" wrote:

Hi Bradley

This runs like lightning. I would change the cell you want to use as
your criteria to be a variable then its all down hill.

Take care

Marcus

Sub findit()
'Make 123456 a variable
Find_Range(123456, Columns("B"), xlFormulas, xlWhole). _
EntireRow.Copy Range("Sheet2!B65536").End(xlUp).Offset(1, 0).EntireRow
End Sub


Function Find_Range(Find_Item As Variant, _
Search_Range As Range, _
Optional LookIn As Variant, Optional LookAt As Variant, _
Optional MatchCase As Boolean) As Range
Dim c As Range

If IsMissing(LookIn) Then LookIn = xlValues 'xlFormulas
If IsMissing(LookAt) Then LookAt = xlPart 'xlWhole
If IsMissing(MatchCase) Then MatchCase = False

With Search_Range
Set c = .Find(What:=Find_Item, LookIn:=LookIn, _
LookAt:=LookAt, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=MatchCase, _
SearchFormat:=False)
If Not c Is Nothing Then
Set Find_Range = c
firstAddress = c.Address
Do
Set Find_Range = Union(Find_Range, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With

End Function
.