nested find/find next

C

crj

I am trying to find all ted for timesheet records for a certain date. Once I
find a record I need to do another find to see if I have a display line
already created for that project number. If I do I want to update it rather
than create a new lne.

My problem is that when I go to my next date the findnext looks for project
rather than date (find next runs against last find rather than the first find)

here is the code:
Application.Goto Sheets("Timesheet").Range("B2")
LR = Cells(Rows.Count, 2).End(xlUp).Row
Set tsRange = Worksheets("Timesheet").Range("B2:E" & LR)

Set refRange = Worksheets("Reference").Range("C5")
Set pdbRange = Worksheets("ProjectDB").Range("B:J")

Application.Goto Sheets("ProjectDB").Range("B22")
pdbLR = Cells(Rows.Count, 2).End(xlUp).Row

If pdbLR > 21 Then
Range("B22:J" & pdbLR).Select
Selection.ClearContents
End If

Range("B22:B" & pdbLR).Select
Selection.NumberFormat = "0000000000"

pdbNextline = 22

For i = 1 To 7
If i = 1 Then datetofind = CDate(refRange.Value - 6)
If i = 2 Then datetofind = CDate(refRange.Value - 5)
If i = 3 Then datetofind = CDate(refRange.Value - 4)
If i = 4 Then datetofind = CDate(refRange.Value - 3)
If i = 5 Then datetofind = CDate(refRange.Value - 2)
If i = 6 Then datetofind = CDate(refRange.Value - 1)
If i = 7 Then datetofind = CDate(refRange.Value)

With tsRange
Set c = .Find(datetofind, LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
rowfound = c.Row
If i = 1 Then
'Project #
Worksheets("projectdb").Range("B" & pdbNextline).Value =
Worksheets("timesheet").Range("C" & rowfound).Value
'Activity
Worksheets("projectdb").Range("C" & pdbNextline).Value =
Worksheets("timesheet").Range("E" & rowfound).Value
'Hours
Worksheets("projectdb").Range("D" & pdbNextline).Value =
Worksheets("timesheet").Range("D" & rowfound).Value
pdbNextline = pdbNextline + 1
End If
If i = 2 Then
Application.Goto Sheets("ProjectDB").Range("B22")
pdbLR = Cells(Rows.Count, 2).End(xlUp).Row
AlreadyUpdated = False
projectToUpdate = Worksheets("Timesheet").Range("C" &
rowfound).Value

With Worksheets("ProjectDB").Range("B22:C" & pdbLR)
Set pdbc = .Find(projectToUpdate, LookIn:=xlValues)
If Not pdbc Is Nothing Then
pdbfirstAddress = pdbc.Address
Do
pdbrowfound = pdbc.Row
'Select
If Worksheets("ProjectDB").Range("C" & pdbrowfound).Value
= Worksheets("Timesheet").Range("E" & rowfound).Value Then
'add Hours
Worksheets("ProjectDB").Range("E" & pdbrowfound).Value
= Worksheets("Timesheet").Range("D" & rowfound).Value
AlreadyUpdated = True
End If
Set pdbc = .FindNext(pdbc)
If pdbc Is Nothing Then Exit Do
If pdbc.Address = pdbfirstAddress Then Exit Do
Loop
End If
End With
If Not AlreadyUpdated Then
'Project #
Worksheets("projectdb").Range("B" & pdbNextline).Value =
Worksheets("timesheet").Range("C" & rowfound).Value
'Activity
Worksheets("projectdb").Range("C" & pdbNextline).Value =
Worksheets("timesheet").Range("E" & rowfound).Value
'Hours
Worksheets("projectdb").Range("E" & pdbNextline).Value =
Worksheets("timesheet").Range("D" & rowfound).Value
pdbNextline = pdbNextline + 1
End If
End If 'i=2
If i = 3 Then

End If 'i=3
If i = 4 Then

End If 'i=4
If i = 5 Then

End If 'i=5
If i = 6 Then

End If 'i=6
If i = 7 Then

End If 'i=7
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
Next i
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top