How to fill an array with values in column C based on Column D date value of Today

Hi

OK just replace the old code with this........... i updated it since the sample i sent you earlier

Public Sub FillShippingReport()

    Dim DataSht As Excel.Worksheet
    Dim DataArr As Variant
    Dim TDate As Variant
    Dim TData As Variant
    Dim LastRow As Long
    Dim Rw As Long

    Set DataSht = ThisWorkbook.Sheets("2015 Log")
    LastRow = DataSht.Range("D" & DataSht.Rows.Count).End(xlUp).Row
    DataArr = DataSht.Range("C3:D" & LastRow).Value
    TDate = DateTime.Date
    
    For Rw = LBound(DataArr, 1) To UBound(DataArr, 1)

        If DataArr(Rw, 2) = TDate Then
        
            If IsArray(TData) Then
                ReDim Preserve TData(2, UBound(TData, 2) + 1)
                TData(1, UBound(TData, 2)) = DataArr(Rw, 1)
                TData(0, UBound(TData, 2)) = DataArr(Rw, 20)
                TData(2, UBound(TData, 2)) = DataArr(Rw, 5)'<NOT SURE IF THIS IS THE RIGHT COLUMN
            Else
                ReDim TData(2, 0)
                TData(1, 0) = DataArr(Rw, 1)
                TData(0, 0) = DataArr(Rw, 20)
                TData(2, 0) = DataArr(Rw, 5) '<NOT SURE IF THIS IS THE RIGHT COLUMN
            End If
        
        End If

    Next Rw

    Set DataSht = ThisWorkbook.Sheets("Shipping Report")
    DataSht.Range("B7:D7").Resize(UBound(TData, 1) + 1, 3).Value = Application.Transpose(TData)

End Sub

just give it a try, dont forget to change some dates to today

Thanks
Paul S.

It errors out (Subscript out of range) at this line

          TData(0, 0) = DataArr(Rw, 20)

Sorry

Set DataSht = ThisWorkbook.Sheets("2015 Log")
    LastRow = DataSht.Range("D" & DataSht.Rows.Count).End(xlUp).Row
    DataArr = DataSht.Range("C3:V" & LastRow).Value   '<------CHANGE C3:D TO C3:V
    TDate = DateTime.Date

Try this

Ok, almost there, Now it is putting the Packing List # in the right spot, but it is only taking the first 3 instances where it finds the todays date. Then it is putting the Tracking # in the Project # column leaving the Tracking # column empty. See attached file. I changed a date in an earlier shipment to todays date and added one to the end for a total of 5 entries that would be on the shipping report for 1/9

Totally different method...

Sub test()
    Dim x, temp
    With Sheets("2015 log")
        With .Range("c2", .Range("c" & Rows.Count).End(xlUp)).Resize(, 20)
            x = Filter(.Parent.Evaluate("transpose(if(" & .Columns(2).Address & _
                "=today(),row(1:" & .Rows.Count & "),char(2)))"), Chr(2), 0)
                If UBound(x) > -1 Then
                    temp = Application.Index(.Value, Application.Transpose(x), Array(20, 1))
                    With Sheets("shipping report").Range("b" & Rows.Count).End(xlUp)(2)
                        If UBound(x) = 0 Then
                            .Resize(, 2).Value = temp
                        Else
                            .Resize(UBound(temp, 1), 2).Value = temp
                        End If
                    End With
                Else
                    MsgBox "No today's data"
                End If
        End With
    End With
End Sub

Wow if i need to obfuscate my work ill contact you .. joke

interesting method.

Thanks for the help now I will try and mend it to work with separate workbooks.

You just need to modify the Sub Header and a line or 2 of code.

Public Sub FillShippingReport(SheetName As String) '<-----Here

    Dim DataSht As Excel.Worksheet
    Dim DataArr As Variant
    Dim TDate As Variant
    Dim TData As Variant
    Dim LastRow As Long
    Dim Rw As Long

    Set DataSht = ThisWorkbook.Sheets(SheetName)'<-----Here
    LastRow = DataSht.Range("D" & DataSht.Rows.Count).End(xlUp).Row

then if you have a button your planning on putting on each sheet you can easily call this sub using the correct name.

Code the 2015 sheets button to

Call FillShippingReport("2015")

This would require you create controls on each sheet and code them slightly diferent........ or you could use the current Year (2016) to determin where the new data is comming from or a textbox etc etc.