Is there a VB for this?

[shadyshawn]

I pasted to excel an rtf-format report that looks like below, and it shows up as one column. I wonder if I can: extract the ones in red and to paste them into a different sheet in two columns.

Also, the number of codes(breaks, coaching...) could vary each day, so the number of rows for red data will vary. And as you can see it has multiple days, so I need to extract red data from each day and to paste them into different worksheets.

Any help here is greatly appreciated!!

<table style="width: auto;"><tbody><tr><td></td></tr><tr><td style="font-family: arial,sans-serif; font-size: 11px; text-align: right;">From Mar 11, 2011</td></tr></tbody></table>

 

[Rasm]

ok
something like this - you did not post so I can copy your data - so I cannot write actual code - but here it goes


Option Compare Text ' makes string comparisons case insensetive
dim MyString() as string
for i=1 to lastrow ' google how to find LastRow
Aint=instr(1,activeworksheet.cells(i,1),"Break")
if Aint=0 then instr(1,activeworksheet.cells(i,1),"Next string to search for")
enter the other text strings to search for - use same line as above - but different etx string
If Aint>0 then
MyString=split(activeworrksheet.cells(i,1)," ") 'assuming there is space between the text
For ii=0 to ubound(MyString)
IF MyString(ii)<> vbnullstring then
Now write this variable to where ever you wnat
end if
Next ii
end if
next i

 

[shadyshawn]

Thanks Rasm! my data are like below, although it's aligned like what the pic I posted previously..



From: 03/05/11 XXXXXXXXXX
Summary
To: 03/06/11 ABC Inc. Daily
All Day XXXX Report Page: 1


392 MCTN
Time Zone: EST
Report Across Moves: No
Include Codes: ALL
Sort By XXXX
Show xxxxxxxxxxxxxxxxx
Show xxxxxxxxxxxxxxxxxx

Duration
Code HH:MM Percent

Summary Data For: Date: 03/05/11

Total: 19
Break 3:15 1.89%
Coaching 1:29 0.86%
Extra time 17:25 10.15%
Late 0:23 0.22%
Lunch 7:00 4.08%
Sick 19:00 11.07%
Vacation 8:00 4.66%
Total 100:32



From: 03/05/11 XXXXXXXXXX
Summary
To: 03/06/11 ABC Inc. Daily
All Day XXXX Report Page: 2


392 MCTN
Time Zone: EST
Report Across Moves: No
Include Codes: ALL
Sort By XXXX
Show xxxxxxxxxxxxxxxxx
Show xxxxxxxxxxxxxxxxxx

Duration
Code HH:MM Percent

Summary Data For: Date: 03/06/11

Total: 19
Break 23:15 1.89%
Coaching 11:29 0.86%
Extra time 67:25 10.15%
Late 10:23 0.22%
Lunch 27:00 4.08%
Open Time 83:55 48.91%
Sick 19:00 11.07%
Training 7:00 4.08%
Vacation 8:00 4.66%
Total 100:32

 

[Rasm]

Try this - I simply copied the data into A1 on sheet1 - now run the macro ParseData - the parsed data are copied to Sheet2 - not sure if this is what you want - but just edit the code to fit your needs - this at least shows you one way to do it. Have fun

PS - Sorry - I missed the link to the data first time around


Module1

Option Explicit
Option Compare Text
Public Sub ParseData()
    Dim LastRow As Long
    Dim i As Long
    Dim Counter As Long
    Dim Aint As Integer
    Dim MyString() As String
    Application.StatusBar = "Working hard"
    With Sheets(1).UsedRange
        LastRow = .Rows(.Rows.Count).Row
    End With
    If LastRow < 1 Then 'empty sheet
        MsgBox ("Sheet is empty")
        Exit Sub
    End If
    With Sheets(2)
        Counter = 0
        For i = 1 To LastRow
            Aint = InStr(1, Sheets(1).Cells(i, 1), "Summary Data For")
            If Aint > 0 Then
                Counter = Counter + 1
                MyString = Split(Sheets(1).Cells(i, 1), ":")
                .Cells(1, 1) = MyString(1)
                .Cells(1, Counter + 1) = MyString(2)
            End If
            Aint = InStr(1, Sheets(1).Cells(i, 1), "Break ")
            If Aint > 0 Then
                MyString = Split(Sheets(1).Cells(i, 1), " ")
                .Cells(2, 1) = MyString(0)
                .Cells(2, Counter + 1) = MyString(1)
            End If
            Aint = InStr(1, Sheets(1).Cells(i, 1), "Coaching ")
           If Aint > 0 Then
                MyString = Split(Sheets(1).Cells(i, 1), " ")
                .Cells(3, 1) = MyString(0)
                .Cells(3, Counter + 1) = MyString(1)
           End If
            Aint = InStr(1, Sheets(1).Cells(i, 1), "Extra time ")
            If Aint > 0 Then
                MyString = Split(Sheets(1).Cells(i, 1), " ")
                .Cells(4, 1) = MyString(1)
                .Cells(4, Counter + 1) = MyString(2)
            End If
           Aint = InStr(1, Sheets(1).Cells(i, 1), "Late ")
            If Aint > 0 Then
                MyString = Split(Sheets(1).Cells(i, 1), " ")
                .Cells(5, 1) = MyString(0)
               .Cells(5, Counter + 1) = MyString(1)
            End If
            Aint = InStr(1, Sheets(1).Cells(i, 1), "Lunch ")
           If Aint > 0 Then
                MyString = Split(Sheets(1).Cells(i, 1), " ")
                .Cells(6, 1) = MyString(0)
                .Cells(6, Counter + 1) = MyString(1)
            End If
            Aint = InStr(1, Sheets(1).Cells(i, 1), "Sick ")
            If Aint > 0 Then
                MyString = Split(Sheets(1).Cells(i, 1), " ")
                .Cells(7, 1) = MyString(0)
                .Cells(7, Counter + 1) = MyString(1)
            End If
            Aint = InStr(1, Sheets(1).Cells(i, 1), "'Vacation ")
            If Aint > 0 Then
                MyString = Split(Sheets(1).Cells(i, 1), " ")
                .Cells(8, 1) = MyString(0)
                .Cells(8, Counter + 1) = MyString(1)
            End If
        Next i
    End With
    Application.StatusBar = "I am done Working hard  --- start next task"
End Sub