Looking at data sheet and then transferring data according to date to fixed range

[Admin]

Hi

Try this.

Private Sub CommandButton1_Click()
    
    Dim wksSource   As Worksheet
    Dim wksDest     As Worksheet
    Dim n           As Long
    Dim i           As Long
    Dim j           As Long
    Dim lngDate     As Long
    Dim rngDest     As Range
    Dim Data, arrOP()
    
    If Me.ComboBox1.ListIndex = -1 Then Exit Sub
    j = Me.ListBox1.ListIndex
    If j = -1 Then Exit Sub
    
    lngDate = CLng(DateValue(Me.ComboBox1.Value))
    
    Set wksSource = ThisWorkbook.Worksheets("team a")
    Set wksDest = ThisWorkbook.Worksheets("group a")
    
    Data = wksSource.Range("b8:v" & wksSource.Range("b" & wksSource.Rows.Count).End(xlUp).Row).Value2
    
    If IsArray(Data) Then
        ReDim arrOP(1 To UBound(Data, 1), 1 To 3)
        For i = 1 To UBound(Data, 1)
            If Data(i, 1) = lngDate Then
                Select Case j 'Listbox Selection
                    Case 0 'Planned stop
                        'check for data
                        If Len(Data(i, 10)) Then
                            n = n + 1
                            arrOP(n, 1) = CDate(Data(i, 1)) 'date
                            arrOP(n, 2) = Data(i, 10) 'Reason
                            arrOP(n, 3) = Data(i, 11) 'time
                        End If
                    Case 1
                        'check for data
                        If Len(Data(i, 13)) Then
                            n = n + 1
                            arrOP(n, 1) = CDate(Data(i, 1)) 'date
                            arrOP(n, 2) = Data(i, 13) 'part
                            arrOP(n, 3) = Data(i, 16) 'time
                        End If
                    Case 2
                        'check for data
                        If Len(Data(i, 18)) Then
                            n = n + 1
                            arrOP(n, 1) = CDate(Data(i, 1)) 'date
                            arrOP(n, 2) = Data(i, 18) 'Reason
                            arrOP(n, 3) = Data(i, 20) 'time
                        End If
                End Select
            End If
        Next
        If n Then
            Set rngDest = wksDest.Range("o5").Offset(j * 9 + 1)
            rngDest.Resize(6, 3).ClearContents
            rngDest.Resize(n, 3) = arrOP
        End If
    End If
    
    Unload Me
    
End Sub

[jeff]

Thanks Admin

I learnt a bit and changed the code so that i included the comments as well.It works so i guess i got it correct.Also added a delete code.

My only request is how do i have all 3 items in the listbox transfer at the same time.Press the transfer button once and the 3 listed are transfer simultaneously

Thank you for your help