[Giúp đỡ] Liệt kê công việc quá hạn trong danh sách

[quyenpv]

Dear anh chị!
Nhờ anh chị giúp em code liệt kê các công việc trong Sheet "Data" quá hạn so với ngày hiện tại, em mò code nhưng chạy không đúng
1. Liệt kê theo danh mục công việc được tô đạm

2. Sắp xếp theo tên từng cá nhân phụ trách công việc đó

Mong anh chị xem và giúp đỡ ạ, nếu được cho em xin code luôn phần gửi email nữa ạ

Option Explicit
Option Private Module

Sub Run_BB_HetHan_SapHet()

    Dim i, k, kk, ar, Arr_SapHetHan, Arr_HetHan
    Dim Nguon, Dong
    Dim LastRow_HH, LastRow_SHH
    Dim xRgDateVal As String
    
    On Error Resume Next
    
    With Sheets("Data")
        Dong = .Range("B3").End(xlDown).Row
        Nguon = .Range("A563", "O" & Dong)                          'Cot cuoi cung tai Sheet Input_TB
        Dong = UBound(Nguon)
    End With

    ReDim Arr_SapHetHan(1 To Dong, 1 To 12)
    ReDim Arr_HetHan(1 To Dong, 1 To 12)

    'Chay kiem tra dau viec sap het han
    For i = 1 To Dong
        
        If CDate(Nguon(i, 7)) - Date <= 7 Then ' And CDate(Nguon(i, 7)) - Date > 0 Then
            k = k + 1
            Arr_SapHetHan(k, 1) = k
            Arr_SapHetHan(k, 2) = Nguon(i, 5)
            Arr_SapHetHan(k, 3) = Nguon(i, 1)
            'Arr_SapHetHan(k, 4) = Nguon(i, 4)          'Ten VTTB
            Arr_SapHetHan(k, 5) = Nguon(i, 4)          'Ma VT
            Arr_SapHetHan(k, 6) = Nguon(i, 6)          'So luong nghiem thu
            Arr_SapHetHan(k, 7) = Nguon(i, 7)
'            Arr_SapHetHan(k, 8) = Nguon(i, 7) - Date

            'Don gia
            Arr_SapHetHan(k, 9) = Nguon(i, 8)          'Don gia
            Arr_SapHetHan(k, 10) = Nguon(i, 9)          'Don gia
            Arr_SapHetHan(k, 11) = Nguon(i, 10)          'Don gia
        End If

    Next i

    Sheets("Baocao").Select

    With Sheets("Baocao")
'        .Range("A6").Resize(k, 12).Value = Arr_HetHan
        LastRow_SHH = Sheets("Baocao").Cells(Rows.Count, "D").End(xlUp).Row
        .Range("B" & LastRow_SHH + 1).Formula = "CONG VIEC SAP HET HAN"

        If k Then
            .Range("A" & LastRow_SHH + 2).Resize(k, 12).Value = Arr_SapHetHan
        End If

        '      .Range("C3:F" & 12 + k - 1).WrapText = 1
        '      .Range("C3:F" & 12 + k - 1).HorizontalAlignment = xlJustify
        '      .Range("A12:M" & 12 + k - 1).Font.Bold = False
'        .Range("A4").Resize(kk, 12).Borders.LineStyle = 1

        '      .Range("H12:J" & 12 + k + 1).NumberFormat = "#,##0.00"
        '      .Range("J" & 12 + k + 1).Formula = "=SUBTOTAL(9,J12:J" & 12 + k & ")"
        'Can chinh
        '      .Rows("12:" & LastRow - 1 & "").RowHeight = 35
        '      .Rows("" & LastRow & ":" & LastRow + 4 & "").RowHeight = 23
        .PageSetup.PrintArea = "$A$1:$L" & LastRow_SHH + 4 & ""
    End With

End Sub

 

[Cá ngừ F1]

Dear anh!
Có cách nào mình lọc theo tên từng người trước được không anh

Cái cột trách nhiệm ko phải tên người hay sao bạn?
Hay vẫn còn 1 cột tên khác?

 

[quyenpv]

Đó là tên người thực hiện công việc đó anh ạ

 

[quyenpv]

Cái cột trách nhiệm ko phải tên người hay sao bạn?
Hay vẫn còn 1 cột tên khác?

Đó là cột tên người phụ trách anh và là cột duy nhất ạ

 

[Cá ngừ F1]

Đó là cột tên người phụ trách anh và là cột duy nhất ạ

Trong bảng Data của bạn, tôi không thấy cột nào là cột tên người phụ trách?

 

[quyenpv]

Trong bảng Data của bạn, tôi không thấy cột nào là cột tên người phụ trách?

Dạ cột F (Trách nhiệm) đó anh

 

[Cá ngừ F1]

Dạ cột F (Trách nhiệm) đó anh

Bên sheet Baocao, bạn muốn sắp xếp theo cột Trách nhiệm, đoạn cuối có phần code này đã sắp xếp tăng dần, dùng rồi mà nhỉ? hay tôi chưa hiểu ý bạn?

....
Sheets("BaoCao").[A4:L10000].Sort [B4], 1, Header:=xlYes
....