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
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