Find a word and extract data to another sheet

[sindhuja]

Hi,

I have imported a .txt file (large data) in a excel file in which i have to search for the text "Subtotals for Department" and find the corresponding department and the total items for that department...

I tried delimiting the contents after importing to xls and deleted the entire row and am not sure of proceeding further..:doh:

Also attached the file with the working highlighted...

Any help on this will be highly appreciated.
Thanks in advance !!!

-Sindhuja

[sindhuja]

Here is the coding i tried....
i tried to find out the department but not the total number of items...

Sub find()
Dim Dep As Range
Dim FirstAddress As String
Dim dept As String
Dim Tot As Range

With Sheets("Sheet1").Columns(2)
Set Dep = .find(What:="Subtotals for Department", _
LookIn:=xlValues, lookat:=xlPart)
FirstAddress = Dep.Address
Do
If Not Dep Is Nothing Then
Set Dep = .FindNext(Dep)
dept = Dep.Offset(, 1).Value
MsgBox dept
Set Tot = .find(What:="Total", LookIn:=xlValues, _
lookat:=xlPart, After:=Dep)
MsgBox Tot

End If
Set Dep = .find(What:="Subtotals for Department:", _
LookIn:=xlValues, lookat:=xlPart, After:=Dep)
Loop While Not Dep Is Nothing And Dep.Address <> FirstAddress
End With

End Sub

-Sindhuja

[tstav]

Hi sindhuja,
This will find the values you are looking for and write them to the 'Out' Sheet
Sub FindAndCopy()
Dim dep As Range, firstAddress As String
'If you need to first clear the 'Out' cells, de-comment the following 3 lines
'With Worksheets("Out")
' .Range("A2").Resize(.Rows.Count - 1, 2).ClearContents
'End With
With Worksheets("Sheet1").Cells
Set dep = .Columns(2).Find(What:="Subtotals for Department:", LookIn:=xlValues, LookAt:=xlPart)
If Not dep Is Nothing Then
firstAddress = dep.Address
Do
'Write values
With Worksheets("Out")
.Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).Value = dep.Offset(0, 1).Value
.Range("A" & .Rows.Count).End(xlUp).Offset(0, 1).Value = dep.Offset(3, 2).Value
End With
Set dep = .FindNext(dep)
Loop While Not dep Is Nothing And dep.Address <> firstAddress
End If
End With
End Sub

[sindhuja]

Thanks for the quick response tstav :friends:

Have a great day ahead....
-Sindhuja

[tstav]

And if there are a lot of rows to write to the 'Out' sheet, this slight variation may speed things up a bit (otherwise it won't make any difference, apart that I find it somewhat easier to read)
Sub FindAndCopy()
Dim dep As Range, rng As Range, firstAddress As String
'If you need to first clear the 'Out' cells, de-comment the following 3 lines
'With Worksheets("Out")
' .Range("A2").Resize(.Rows.Count - 1, 2).ClearContents
'End With
With Worksheets("Sheet1").Cells
Set dep = .Columns(2).Find(What:="Subtotals for Department:", LookIn:=xlValues, LookAt:=xlPart)
If Not dep Is Nothing Then
firstAddress = dep.Address
Do
'Copy values
With Worksheets("Out")
Set rng = .Range("A" & .Rows.Count).End(xlUp)
rng.Offset(1, 0).Value = dep.Offset(0, 1).Value
rng.Offset(1, 1).Value = dep.Offset(3, 2).Value
End With
Set dep = .FindNext(dep)
Loop While Not dep Is Nothing And dep.Address <> firstAddress
End If
End With
End Sub

[sindhuja]

Hi tstav,

One more query !!!

we just extract the dept and the total details from sheet1 and put those details in "Out" sheet. There is a slight modifications in the Out sheet.

The modification is that we have predefined all the departments and what we have to do now is to put the total number (column H) in the corresponding dept of the out sheet...

Hope if you look at the attachment it will be clear...

-Sindhuja

[tstav]

Here is the new code. Take notice of the comments.
Sub FindAndCopy2()
Dim dep As String, startRow As Long, endRow As Long, i As Long, cel As Range
'--------------------------------------------------------
'Prerequisite: There must always be a blank row
'separating the top panel from the next one in Sheet 'Out',
'otherwise you need to hard code the value of endRow
'--------------------------------------------------------
'This is the startRow of the list of Departments in 'Out'
startRow = 9 '<-- Fix this if it is different than 9
With Worksheets("Out")
endRow = .Range("B9").End(xlDown).Row - 1 '<--Fix this (e.g.=16) if no blank row exists
End With
With Worksheets("Sheet1").Cells
For i = startRow To endRow
dep = Worksheets("Out").Range("B" & i).Value
Set cel = .Columns("C").Find(What:=dep, After:=.Range("C" & .Rows.count), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
'Copy values
If Not cel Is Nothing Then
Worksheets("Out").Range("H" & i).Value = cel.Offset(3, 1).Value
Else
Worksheets("Out").Range("H" & i).Value = 0
End If
Next 'i
End With
End Sub

[sindhuja]

Thanks tstav...:friends:

[sindhuja]

Hi tstav,

just a quick query !

i have used the above coding and modified as per my needs, but i didnt get the expected results.

my search criteria here is... for all the funds in sheet "ALL Dept" search in Sheet1 (column B) and if any of the funds with the corresponding column A values as "Subtotal for Department" only that is to be considered.

Have highlighted the values i am in need of...

hope this will be clear..

-Sindhuja

[tstav]

sindhuja,
in your attachment file, all depts had a 'Subtotal for Department' to their left and this kind of misled me into not considering this specific condition. Anyhow, I revised the code, so you check it out and let me know.

PS: There is no sheet by the name of "ALL Dept" in your attached file (I'm referring to the attachment of your post#6, which is what I have used as a test file).
Sub FindAndCopy3()
Dim dep As String, strAddress As String
Dim startRow As Long, endRow As Long, i As Long
Dim cel As Range
'--------------------------------------------------------
'Prerequisite: There must always be a blank row
'separating the top panel from the next one in Sheet 'Out',
'otherwise you need to hard code the value of endRow
'--------------------------------------------------------
'This is the startRow of the list of Departments in 'Out'
startRow = 9 '<-- Fix this if it is different than 9
With Worksheets("Out")
endRow = .Range("B9").End(xlDown).Row - 1 '<--Fix this (e.g.=16) if no blank row exists
End With
With Worksheets("Sheet1").cells
For i = startRow To endRow
dep = Worksheets("Out").Range("B" & i).Value
Set cel = .Columns("C").Find(What:=dep, After:=.Range("C" & .Rows.count), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
'If value found
If Not cel Is Nothing Then
Do
'if 'Subtotals for Dept' found
If cel.Offset(0, -1).Value Like "*Subtotals for Department*" Then
'Write the total and check the next Dept
Worksheets("Out").Range("H" & i).Value = cel.Offset(3, 1).Value
Exit Do
End If
strAddress = cel.Address
Set cel = .FindNext(cel)
Loop While Not cel Is Nothing And cel.Address <> strAddress
Else
Worksheets("Out").Range("H" & i).Value = 0
End If
Next 'i
End With
End Sub

[sindhuja]

Thanks tstav.:thumb

I got an error message in the below line :

If cel.Offset(0, -1).Value Like "*Subtotals for Department*" Then

Error occurs only after searching the first 2 funds in the "out" sheet.

Also I need to extract only the value $16,501 from the cell value Daily 16,501 in the column C of "out" sheet

I renamed the "Out" sheet as "ALL Dept" sheet.


-Sindhuja

[tstav]

I got an error message in the below line
1. It would help if you gave the full error message (number, description).
2. What is the value of the cell to the left of the "third" fund in Sheet1? (the cell where the Subtotals for etc. would be)
3. As for the extracting the number from the 'Daily 16,501', if we suppose the cell is C9, then use
MyValue=Split(Worksheets("ALL Dept").Range("C9").Value)(1)

Maybe it'd be better if you attached a newer piece of your file with more details.

[sindhuja]

Thanks tstav,

I did some modifications and not getting error message now

To extract the value I tried the below coding and it works fine?

Worksheets("ALL Dept").Range("c" & i).Value = Right(cel.Offset(2, -1).Value, 10)

-Sindhuja

[tstav]

Good job sindhuja :thumb
Regards
tstav

[sindhuja]

Hi tstav,

All because of your help !!
Really helped me a lot !!

-Sindhuja