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

I can't find anything on NetWorkDays within VBA. Closest I came to was some truncated code here, which I took a stab at (seems to work)

[vba]
Sub Populate()
Dim rFund As Range, PayDate As Range
Dim Fund As Long
Dim rTot As Range
Dim FirstAddress As String
With Sheets("Sheet1").Columns(1)
'Find first Paid & Wait (P&W)
Set rTot = .Find(What:="PAID & WAIT TOTAL", _
LookIn:=xlValues, lookat:=xlPart)
FirstAddress = rTot.Address
Do
'If no P&W value then find next
If Not rTot Is Nothing And rTot.Offset(, 1) < 1 Then
Do
Set rTot = .FindNext(rTot)
Loop Until Not rTot.Offset(, 1) < 1
'With P&W value, find Fund value
Set rFund = .Find(What:="FUND #:", LookIn:=xlValues, _
lookat:=xlPart, After:=rTot)
Fund = Mid(rFund, 9, 4)
'Check PayDate and infill data
Set PayDate = rTot.End(xlUp)
If BizDateDiff(PayDate, Date, 1) <= 8 Then
Call GetData(rTot, PayDate, Fund)
End If
End If
'Find new P&W value
Set rTot = .Find(What:="PAID & WAIT TOTAL", _
LookIn:=xlValues, lookat:=xlPart, After:=rTot)
Loop While Not rTot Is Nothing And rTot.Address <> FirstAddress
End With
End Sub

Sub GetData(rTot As Range, PayDate As Range, Fund As Long)
Dim tgt As Range
Set tgt = Sheets("Paid & Wait").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 10)
tgt(1) = Fund
tgt(2) = Split(rTot)(0)
tgt(3) = PayDate
tgt(4) = Split(PayDate.Offset(-1))(2)
tgt(5) = Split(PayDate.Offset(-1))(3)
tgt(6) = PayDate.Offset(-1, 1)
tgt(7) = PayDate.Offset(-1, 2)
tgt(8) = PayDate.Offset(-1, 5)
tgt(9) = PayDate.Offset(-1, 6)
End Sub

Public Function BizDateDiff(ByVal varDateStart As Date, ByVal varDateEnd As Date, DayNumber) As Integer
' DayNumber (sunday =1,monday=2…)
Dim varNextDate As Date
'This function calculates the weekdays between two dates.
'Exit if variables not a valid date
If Not IsDate(varDateStart) Or Not IsDate(varDateEnd) Then
BizDateDiff = 0
Exit Function
End If
varNextDate = varDateStart
BizDateDiff = 0
While Not varDateEnd < varNextDate
If Weekday(varNextDate) <> 1 And Weekday(varNextDate) <> 7 Then
BizDateDiff = BizDateDiff + 1
End If
varNextDate = varNextDate + 1
Wend
End Function

[/vba]

Thanks MD..

But i am confused :confused: why the output is not displayed in the "Paid & Wait".

I checked for the outputs using MSGBOX.. it works fine and shows the exact values what i needed without any errors, but unable to view the values in the concern sheet and am not sure why.. where is the problem...

As am new to VBA am not able to figure out..

-Sindhuja

Not a VBA problem. As far as I can see, there is no valid data in your posted sample to provide an output
Try changing the value here from 8 to 30
[VBA]
If BizDateDiff(PayDate, Date, 1) <= 8 Then
[/VBA]

Malcolm could you not use the Analasys Toolpak in VBA? In the VB editor, from the main menu bar choose Tools/References and then select atpvbaen.xls from the list. That is the analysis toolpak. You can then use Networkdays like any other VBA function.

That's what I was looking for. I just couldn't find it. I'll give it a try.
Thanks Simon.

Hi MD,
Correct me if I am wrong?.

I tried out the coding..

Am facing the same problem? datas I needed are not updated in the "Paid & Wait" sheet.

Only if the condition satifies If BizDateDiff(PayDate, Date, 1) <= 8 Then it will call the procedure GetData

So we are ok with the data..And I checked by putting message boxes and it works fine? it pulls the correct data...

As it pulls correct data we should also found that in the "Paid & Wait" sheet but we are not finding so?

Really don?t know what causes this issue.

Please help me out and this is very urgent.
Immediate help will be highly appreciated.

-Sindhuja

Did you try the change detailed in Post #23? What output did you get?

Hi,

I have attached the .xls file with the resulting values i expected and also results we arrived by this code..

Have a look and help me out in this...

-Sindhuja

Hi,

This is really very urgent:( and any help to solve this will be highly helpful...

-Sindhuja

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

Thanks MD :clap:and coding works fine... showing up the expected results...

And one more concern regarding this..

If i run the macro in the "PAID & WAIT" sheet its not showing up the values, instead if run the macro in Sheet 1(Active sheet) its giving me the expected result.. I dont know why and what makes the difference..

Any idea on this...
Once again thanks for all your help..:thumb
Learned a lot and quite interested in learning new things...

-Sindhuja

I've corre cted my previous code. "Cells" was not referenced properly as in
[vba]
For i = rTot.Row To rFund.Row Step -1
If IsDate(.Cells(i, 1)) Then
Set PayDate = .Cells(i, 1)

[/vba]

Hi MD,

Again a challenge for us..!

Compares the date only if the dates are continuous and if there is a header in between the values to be compared then the dates before/after the header are not taken into consideration.

for example if the value of rTot.Offset(, 1) is 20 and if there is header after the 10th value then the vales from 11th to 20th or 9th to 1st is not taken into consideration. Headers inbetween is just because downloading via txt format.

Is there is a way to fix this..

And one more concern since the downloaded file is very large (about 3000 pages) it takes time to produce the results (approx 10-12 mins) which really a concern... is there a way to speed up the macro

Sorry if am bothering too much...

-Sindhuja

Rather than just asking questions, please suggest a logic to process the data that can give rise to a solution. I'm only working with a small sample. As for spped, I've no idea. You can step through the code to see how it functions. A different logic may be more efficient, let me have your suggestions.

Is this way of working help us out...

To capture the cell address of Paid and Wait total and store in a variable then check for the next paid & wait total. If the value of this is >0 Then delete the text inbetween the current cell and previous cell address...

Am not sure whether this will work out...

-Sindhuja

Write out your steps and apply them manually. If it works, they can be coded.

Sorry,
I don't understand what this is intended to do. If you delete all the text, where do the Fund and Date values come from?

Malcolm do you think this thread has lost focus?, you provided a solution and corrected it, this thread is now following a different route (what it is i have no idea, you should get a medal for sticking with it!) do you feel it has run its course or should be in a thread of its own? personally i believe the former as you are not getting any of the users work to help with or any sensical information.

Simon,
I believe the problem is inconsistent imported data. My solution fits the sample, but maybe not the whole data. I'm hoping the OP will work out the full logic if he needs more help. Maybe a fresh pair of eyes will see what I'm missing, so a new thread will do no harm.

If all these are to be deleted, just do a find and replace for each. Use the Macro Recorder to get the basic code.