Find for a specific word and extract details based on the found value

[mdmackillop]

[vba]
Sub Populate()
Dim rFund As Range, PayDate As Range
Dim Fund As Long
Dim rTot As Range
Dim FirstAddress As String
Dim i As Long
Dim RepDate As Date

RepDate = InputBox("Enter report date", "Report Date", Date)

With Sheets("Sheet1").Columns(1)
'Find first Paid & Wait (P&W)
Set rTot = .Find(What:="PAID & WAIT TOTAL", _
LookIn:=xlValues, lookat:=xlPart, after:=Range("A1"), searchdirection:=xlNext)
FirstAddress = rTot.Address

Do
'If no P&W value then find next
If Not rTot Is Nothing And rTot.Offset(, 1) = 0 Then
Do
Set rTot = .FindNext(rTot)

Loop Until Not rTot.Offset(, 1) < 1
End If

'With P&W value, find Fund value
Set rFund = .Find(What:="FUND #:", LookIn:=xlValues, _
lookat:=xlPart, after:=rTot, searchdirection:=xlPrevious)
Fund = Mid(rFund, 9, 4)
'Check PayDate and infill data
For i = rTot.Row To rFund.Row Step -1
If IsDate(.Cells(i, 1)) Then
Set PayDate = .Cells(i, 1)
Dim chk As Long
chk = BizDateDiff(PayDate, RepDate, 1)
Sheets("sheet1").Cells(PayDate.Row, "M") = chk
Debug.Print chk
If chk <= 8 Then
Call GetData(rTot, PayDate, Fund)
End If
End If
Next i
'Find new P&W value
Set rTot = .Find(What:="PAID & WAIT TOTAL", _
LookIn:=xlValues, lookat:=xlPart, after:=rTot, searchdirection:=xlNext)

Loop While Not rTot Is Nothing And rTot.Address <> FirstAddress
End With
End Sub


[/vba]