How to Extracting information from a spreadsheet

How to extract information from a spreadsheet

Requirement:

The user needs help to write a VBA code which would extract information in the sheet "data" and place it in the sheet "Report" in the attached file.

It would need to find "Agent Login & Name" in the column A and dates when the agent worked, then place it in the sheet "Report" in separate rows. After that the code would need to find the very first status "Ready" for that date and place it next to agent and date in the sheet Report. And the last bit is to find the very last "logout" status of the day and place it after "Ready" in the sheet "Report".

The user has attached a file where in sheet Report that the user manually placed some information from sheet "data", but since the report is very long and gets updated all the time, the VBA code would be helpful.

Solution:

Code:

Sub CreateReport()
    Dim x, y(), xx, e, i As Long, ii As Long, iii As Long, iY As Integer
    
    x = Sheets("data").UsedRange
    With CreateObject("scripting.dictionary")
        For i = 6 To UBound(x, 1)
            If x(i, 1) Like "Agent*" Then xx = .Item(x(i, 1))
        Next
        For Each e In .keys
            iii = 2
            For i = 6 To UBound(x, 1)
                If x(i, 1) = e Then
                    iY = iY + 1: iii = 2
                    ReDim Preserve y(1 To 4, 1 To iY)
                    For ii = i To UBound(x, 1)
                        If IsDate(x(ii, 1)) Then
                            If y(4, UBound(y, 2)) <> "" Then
                                iY = iY + 1: ReDim Preserve y(1 To 4, 1 To iY)
                            End If
                            y(1, UBound(y, 2)) = e: y(2, UBound(y, 2)) = x(ii, 1)
                            iii = ii
                            Do
                                If x(iii, 4) = "Ready" Then
                                    y(3, UBound(y, 2)) = x(iii, 2)
                                    Exit Do
                                End If
                                iii = iii + 1
                            Loop
                            iii = ii + 1
                            Do
                                If x(iii, 4) = "Logout" Then
                                    y(4, UBound(y, 2)) = x(iii, 2)
                                End If
                                If x(iii, 1) <> "" Then Exit Do
                                iii = iii + 1
                            Loop
                        End If
                        If IsDate(x(iii, 1)) Then ii = iii - 1
                        If x(iii, 1) Like "Agent*" Then Exit For
                    Next
                End If
                If x(iii, 1) Like "Agent*" Then
                    i = iii - 1
                    Exit For
                End If
            Next
        Next
    End With
    With Sheets("report")
        .Cells(1).CurrentRegion.Offset(1).Clear
        .[a2].Resize(UBound(y, 2), 4) = Application.Transpose(y)
        .Columns.AutoFit
    End With
    
End Sub

Obtained from the OzGrid Help Forum.

Solution provided by KjBox.