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

[sindhuja]

Hi All,

Here is my requirement..!

I generally download a .txt file (large file) from where i need specific informations.

I find for a specific word and in the next tab there willl be count. If count is 0 we need not do anything.

If it is >=1 then we need to check for the payment date and if date is =< 8 networdays days then the fund , account, trade details needs to be copied in a seperate work sheet.

Am not sure whether this can be done using macros.:doh:
if possible do we use excel or txt file itself as i am new to VBA.

Please help :help me out in this and this is really a large data and it takes long time to finish off the task....

Any suggessions will be highly appreciated !

- Sindhuja

[L@ja]

Hi,
pls attach a txt+xls file, what is the input,and accepted output.
I think it is solvable by excel vba, but I don't see exactly what you have...

bye

[sindhuja]

Thanks for the heads up !

I have attached the sample txt file and the excel file for the workings.
Let me again brief my requirements.

1) search for the word "PAID & WAIT TOTAL". If the tab next to this is 0 need not do anything.. if >=1 then we need need to check for the payment date.

2) If date of payment date is <= 8 networkdays from the date report was generated then we need to get details like fund #, account #, order #.

3) Similary all data needs to be copied. ex if it 2, we need to check for the 2 payment dates.

File contains large volmes and we need to check the whole...

Any quick response will be highly appreciated.

- Sindhuja

[L@ja]

Hi,
I think this is the vector
try to make it

Sub convertxt()
'select preformatted *txt and insert into sheet raw
'you can record it like macrorecorder and correct it manually
End Sub
Sub analize()
'define REPORT DATE
'find last rawsheet row (lastrow)
'find where we will write row(actwriterow)
'cycle start from actrow=2 to lastrow
'if found "PAID & WAIT TOTAL" then check the next cell
'if biggest than 0 then
'select the cells(actrow-2,PAYMT_date_col)
'check date diff
'if needed, then read more details like before select
'write datas like
'sheets("Paid & Wait").cells(actwriterow,1)=fnd
'sheets("Paid & Wait").cells(actwriterow,2)=typ
'sheets("Paid & Wait").cells(actwriterow,3)=paydate
'...etc
'increase actwriterow
'actwriterow = actwriterow + 1
'end if
'cycle End from actrow (2 to lastrow)
'msgbox "analize done"
End Sub

if you need more help, yust write

[mdmackillop]

Hi L@ja,
You have commented evey line of code. Can you fix this?

[L@ja]

Hi,
I just would like to help with the logic.
(first time)
after if it's not enought i will write some working code.

My idea to solve problems to write exactly the problems.
if it's done probably the problem solved (80%)
if Sindhuja can't continue solve the problem than I'll help too.

sorry if i confuse anybody.

[sindhuja]

hi,

Thanks for the help !

To be frank i am not good in coding ! but am trying...
you help will be highly appreciated...

-Sindhuja

[L@ja]

Hi,
some code attached,
but it is still not enought :-)


Sub analize()
'define REPORT DATE
repdate=format(now,"dd.MM.yyyy")
'find last rawsheet row (lastrow)
lastrow=sheets("raw").cells(65500,1).end(xlup).row
'find where we will write row(actwriterow)
actwriterow=sheets("Paid & Wait").cells(5,1).end(xldown).row
if actwriterow>65500 then actwriterow=6
'cycle start from actrow=2 to lastrow
with sheets("raw")
for actrow=2 to lastrow
'if found "PAID & WAIT TOTAL" then check the next cell
if .cells(actrow,2)="PAID & WAIT TOTAL" and .cells(actrow,3)>0 then
'select the cells(actrow-2,PAYMT_date_col)
xdate=.cells(actrow-2,1)
if (repdate-xdate)>8 then
'check date diff
'if needed, then read more details like before select
fnd=.cells(actrow-1111(?),1) 'u have to found it
'because you have a offset points
'...etc
'write datas like
'sheets("Paid & Wait").cells(actwriterow,1)=fnd
'sheets("Paid & Wait").cells(actwriterow,2)=typ
'sheets("Paid & Wait").cells(actwriterow,3)=paydate
'...etc
'increase actwriterow
actwriterow = actwriterow + 1
end if
end if
'cycle End from actrow (2 to lastrow)
next actrow
end with
'msgbox "analize done"
End Sub

I'll come back later
bye

[sindhuja]

Hi L@ja,

Tried out the coding... its not giving me the expected results...

-sindhuja

[Simon Lloyd]

sindhuja, l@ja has been trying to help you help yourself rather than just give you a complete solution, in his attempt to help you learn what is happening he has provided code with some lines commented out these lines if uncommented (by removing the ') will not necessarily work but gives you a push in the right direction as to what you are looking to achieve, his first post showed you the thought process for trying to reach your goal.

[mdmackillop]

Hi,
I've used Data Import to put the data into Sheet1.
Can you please highlight, add comments, fields to be checked etc. on the first 3 items you want to be imported; and also show items which should be ignored, and why.

[sindhuja]

Hi,

Thanks for the help !

Attached the file with the comments and the datas to be filled in the Paid & Wait sheet highlighted.

Also have hidden the rows from 6-25 to show the corresponding headings for easy reference.

Comments given in the corresponding fields which date to be taken and which not to...

Hope this will be clear !
Am new to VBA started learning now only...

Thanks for the help in advance !!!

-Sindhuja

[mdmackillop]

Try this

Option Explicit
Option Compare Text

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)
'MsgBox PayDate
If Application.NetworkDays(PayDate, Date) <= 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

[sindhuja]

Hi MD,

tried out, but showing me the compile error..

"cannot find object or library.."

Is that any refernce i need to add...

-Sindhuja

[mdmackillop]

1. First check that you have no references marked "Missing"; if so, remove the check next to these items

2. You may require the Analysis Toolpack add-in installed to use NetWorkDays.

[sindhuja]

Hi,

Run time error "438"
Object doesn't support this property or method

Again showing error on below line..
If Application.NetworkDays(PayDate, Date) <= 8 Then

help me out !!

-Sindhuja

[mdmackillop]

Is networkdays working as a function on your spreadsheet?

[sindhuja]

Yes MD, If I worked out on separate sheet to find out the network days it works fine…

[mdmackillop]

I test it tomorrow on another PC

[sindhuja]

Hi,

Please help me out in this...

-Sindhuja

[mdmackillop]

I can't find anything on NetWorkDays within VBA. Closest I came to was some truncated code here (http://www.dailydoseofexcel.com/archives/2004/07/19/networkdays/#comment-31806), which I took a stab at (seems to work)


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

[sindhuja]

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

[mdmackillop]

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

If BizDateDiff(PayDate, Date, 1) <= 8 Then

[Simon Lloyd]

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.

[mdmackillop]

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

[sindhuja]

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

[mdmackillop]

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

[sindhuja]

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

[sindhuja]

Hi,

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

-Sindhuja

[mdmackillop]

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

[sindhuja]

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

[mdmackillop]

I've corre cted my previous code. "Cells" was not referenced properly as in

For i = rTot.Row To rFund.Row Step -1
If IsDate(.Cells(i, 1)) Then
Set PayDate = .Cells(i, 1)

[sindhuja]

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

[mdmackillop]

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.

[sindhuja]

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

[mdmackillop]

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

[mdmackillop]

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?

[Simon Lloyd]

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.

[mdmackillop]

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.

[mdmackillop]

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

[Simon Lloyd]

New thread started for clarity here (http://vbaexpress.com/forum/showthread.php?t=19413) Attachment also reproduced in that thread!