Pull info from one sheet to another

[muzzy]

I am trying to use a vb that I have all ready I need to pull info from this sheet. and put it on another sheet. The info I need is Agent Name cell b1, Date cells b3 and b17, and the totals m15, and m30. I also have the end results for you to see. Below you will see the sheet and the VB I was trying to use. Can someone please help.

	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1		Agent: 50336 Adrovel, Mayra
2
3		Date: 5/13/15
4
5		Scheduled Activities	Scheduled Time	Actual Time	Min. in Adherence	Min. out Adherence	Percent in Adherence	+/- Min. in Conformance
6
7
8		AUX 0			0:00		0:01		0		0		0.00%	1
9		AUX 1: Break		0:15		0:14		0		15		0.00%	-1
10		AUX 3: Meeting		0:00		0:39		0		0		0.00%	39
11		AUX 8:Special Projec	2:00		3:31		95		25		79.17%	91
12
13		Logoff			4:30		4:35		267		3		98.89%	5
14		Logon			2:15		0:00		0		135		0.00%	-135
15		Total			9:00		9:00		362		178		67.04%	0
16
17		Date: 5/19/15
18
19		Scheduled Activities	Scheduled Time	Actual Time	Min. in Adherence	Min. out Adherence	Percent in Adherence	+/- Min. in Conformance
20
21
22		AUX 0			0:00		0:01		0		0		0.00%	1
23		AUX 1: Break		0:15		0:39		15		0		100.00%	24
24		AUX 2: Lunch		1:00		0:00		0		60		0.00%	-60
25		AUX 8:Special Projec	0:00		3:45		0		0		0.00%	225
26
27		Logoff			4:15		4:35		240		15		94.12%	20
28	Adherence
29		Logon			3:30		0:00		0		210		0.00%	-210
30		Total			9:00		9:00		255		285		47.22%	0
31
32		Total for 50336 Adrovel, Mayra
33
34
35		Scheduled Activities	Scheduled Time	Actual Time	Min. in Adherence	Min. out Adherence	Percent in Adherence	+/- Min. in Conformance

<colgroup><col span="16"></colgroup><tbody>
</tbody>

vba coding

Sub REPORT()
    For MY_ROWS = 1 To Range("C" & Rows.Count).End(xlUp).Row
        If Not (IsEmpty(Range("C" & MY_ROWS).Value)) Then
            MY_AGENT = Right(Range("C" & MY_ROWS).Value, Len(Range("C" & MY_ROWS).Value) - 7)
            For MY_NEXT_ROWS = MY_ROWS + 1 To Range("C" & MY_ROWS).End(xlDown).Row
                If Left(Range("D" & MY_NEXT_ROWS).Value, 4) = "Date" Then
                    MY_DATE = Right(Range("D" & MY_NEXT_ROWS).Value, Len(Range("D" & MY_NEXT_ROWS).Value) - 12)
                    MY_ACTIVITY = Range("D" & MY_NEXT_ROWS + 1).Offset(4, 4).Value
                    MY_LENGTH = Range("D" & MY_NEXT_ROWS + 1).Offset(12, 12).Value
                    With Sheets("Sheet2")
                        .Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Value = MY_AGENT
                        .Range("E" & Rows.Count).End(xlUp).Offset(1, 0).Value = MY_DATE
                        .Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Value = MY_ACTIVITY
                        .Range("G" & Rows.Count).End(xlUp).Offset(1, 0).Value = MY_LENGTH
                    End With
                End If
            Next MY_NEXT_ROWS
        End If
    Next MY_ROWS
End Sub

The End result:

Agent	Date	Score
50336 Adrovel, Mayra	5/13/15	67.04%
50336 Adrovel, Mayra	5/13/15	47.22%

<colgroup><col><col><col></colgroup><tbody>
</tbody>

 

[Fazza]

Sub maybe()

    Const str_AGENT_AND_DATE_FIELD_IDENTIFIER As String = "Agent: "
    Const str_WANTED_PERCENTAGES_FIELD_IDENTIFIER As String = "Percent in Adherence"
    Const str_DATE_IDENTIFIER As String = "Date: "
    Const str_TOTAL_IDENTIFIER As String = "Total"

    Dim i As Long, k As Long
    Dim lng_Agent_and_Date_Column As Long
    Dim lng_Percentages_Column As Long
    
    Dim lng_Current_Agent_Row As Long
    Dim lng_Current_Date_Row As Long
    

    Dim wks As Excel.Worksheet
    

    Dim arIn As Variant
    Dim arOut(1 To 20000, 1 To 3) As Variant
    

    Set wks = ActiveSheet
    

    lng_Agent_and_Date_Column = wks.Cells.Find(What:=str_AGENT_AND_DATE_FIELD_IDENTIFIER, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows).Column
    lng_Percentages_Column = wks.Cells.Find(What:=str_WANTED_PERCENTAGES_FIELD_IDENTIFIER).Column

    
    arIn = wks.UsedRange.Value
    Set wks = Nothing
    

    k = 1
    arOut(k, 1) = "Agent"
    arOut(k, 2) = "Date"
    arOut(k, 3) = "Score"
    

    For i = LBound(arIn, 1) To UBound(arIn, 1)
        If Left$(arIn(i, lng_Agent_and_Date_Column), 7) = str_AGENT_AND_DATE_FIELD_IDENTIFIER Then lng_Current_Agent_Row = i
        If Left$(arIn(i, lng_Agent_and_Date_Column), 6) = str_DATE_IDENTIFIER Then lng_Current_Date_Row = i
        If arIn(i, lng_Agent_and_Date_Column) = str_TOTAL_IDENTIFIER Then
            k = k + 1
            arOut(k, 1) = Mid$(arIn(lng_Current_Agent_Row, lng_Agent_and_Date_Column), 8, 255)
            arOut(k, 2) = Mid$(arIn(lng_Current_Date_Row, lng_Agent_and_Date_Column), 7, 255)
            arOut(k, 3) = arIn(i, lng_Percentages_Column)
        End If
    Next i
    Erase arIn

    
    With Worksheets("Sheet2")
        .Range("A1").CurrentRegion.Clear
        .Range("A1").Resize(k, 3).Value = arOut
        .Columns("B").NumberFormat = "m/d/yy"
        .Columns("C").NumberFormat = "00.00%"
    End With
    Erase arOut

End Sub

 

[muzzy]

Sub maybe()

    Const str_AGENT_AND_DATE_FIELD_IDENTIFIER As String = "Agent: "
    Const str_WANTED_PERCENTAGES_FIELD_IDENTIFIER As String = "Percent in Adherence"
    Const str_DATE_IDENTIFIER As String = "Date: "
    Const str_TOTAL_IDENTIFIER As String = "Total"

    Dim i As Long, k As Long
    Dim lng_Agent_and_Date_Column As Long
    Dim lng_Percentages_Column As Long
    
    Dim lng_Current_Agent_Row As Long
    Dim lng_Current_Date_Row As Long
    

    Dim wks As Excel.Worksheet
    

    Dim arIn As Variant
    Dim arOut(1 To 20000, 1 To 3) As Variant
    

    Set wks = ActiveSheet
    

    lng_Agent_and_Date_Column = wks.Cells.Find(What:=str_AGENT_AND_DATE_FIELD_IDENTIFIER, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows).Column
    lng_Percentages_Column = wks.Cells.Find(What:=str_WANTED_PERCENTAGES_FIELD_IDENTIFIER).Column

    
    arIn = wks.UsedRange.Value
    Set wks = Nothing
    

    k = 1
    arOut(k, 1) = "Agent"
    arOut(k, 2) = "Date"
    arOut(k, 3) = "Score"
    

    For i = LBound(arIn, 1) To UBound(arIn, 1)
        If Left$(arIn(i, lng_Agent_and_Date_Column), 7) = str_AGENT_AND_DATE_FIELD_IDENTIFIER Then lng_Current_Agent_Row = i
        If Left$(arIn(i, lng_Agent_and_Date_Column), 6) = str_DATE_IDENTIFIER Then lng_Current_Date_Row = i
        If arIn(i, lng_Agent_and_Date_Column) = str_TOTAL_IDENTIFIER Then
            k = k + 1
            arOut(k, 1) = Mid$(arIn(lng_Current_Agent_Row, lng_Agent_and_Date_Column), 8, 255)
            arOut(k, 2) = Mid$(arIn(lng_Current_Date_Row, lng_Agent_and_Date_Column), 7, 255)
            arOut(k, 3) = arIn(i, lng_Percentages_Column)
        End If
    Next i
    Erase arIn

    
    With Worksheets("Sheet2")
        .Range("A1").CurrentRegion.Clear
        .Range("A1").Resize(k, 3).Value = arOut
        .Columns("B").NumberFormat = "m/d/yy"
        .Columns("C").NumberFormat = "00.00%"
    End With
    Erase arOut

End Sub

Thanks but it does not work all I get on sheet2 is Agent, Date and Score. on the page as a title. I know I have been try to get this for about week and a half now. If you can help thank you.

 

[Fazza]

Please explain what you did with the code, including its execution.

 

[Fazza]

In particular, what was done differently using my code from the original code?