Thread: VBA Code to return a summary sheet of due actions

I'd really appreciate some help on this one as I'm totally confused. I am using Microsot Excel 2003. The idea is fairly simple I have a large workbook, one spreadsheet of which (called review dates) is of client names with corresponding review dates (2 weekly, 3/6/12/18 monthly etc, etc). The columns are conditionally formatted to highlight any dates that fall within a week of the present date but its very time consuming and errror prone to scroll through hundreds of rows of client names plus across a number of columns looking for any due reviews. The idea is then to have a single summary worksheet report, to return all due actions detailing clients name, the date that a review is due and the type of review due, (eg 3 month). As stated any help at all would be good, I'm very new to VBA. Many thanks

A

Hi A & Welcome to the Board,

My initial impression is a pivot-table. If this does not suit your needs then how about attaching a small sample workbook of what you have and what you desire.

http://www.pivot-table.com/
http://peltiertech.com/Excel/Pivots/pivottables.htm

Ok based on your sample, you only have one name, Callum. Any reason why only one name?

So in the end, do you want all names which are 7 days on either side of today's date along with the type of review?

Do you want the results wiped out everytime you rerun this macro? I don't see a formula that will do it, but that could just be my lack of understanding.

I think this will do it:

Option Explicit

Sub ReviewDates()

Dim rd As Worksheet: Set rd = Sheets("review dates")
Dim sadNextRow As Long
Dim CheckDate As Date
Dim rdLastRow As Long
Dim rdLastCol As Long
Dim cell As Range

With Sheets("summary actions due")
    sadNextRow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
End With

With Sheets("review dates")
    CheckDate = .Range("B1").Value
    rdLastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    rdLastCol = .Cells(3, .Columns.Count).End(xlToLeft).Column

    For Each cell In .Range("b4", .Cells(rdLastRow, rdLastCol))
        If cell.Value >= CheckDate - 7 _
        And cell.Value <= CheckDate + 7 _
        Then
            With Sheets("summary actions due")
                .Range("C" & sadNextRow).Value = cell.Value
                .Range("B" & sadNextRow).Value = rd.Cells(cell.Row, 1)
                .Range("D" & sadNextRow).Value = rd.Cells(3, cell.Column)
                sadNextRow = sadNextRow + 1
            End With
        End If
    Next 'cell
End With
End Sub

Regards

Thank you TMShucks for the assist.

@A: Please let us know if this meets your needs

You're welcome. Thanks for the rep.

If this answers your question, please mark your thread as solved. See my signature for details or the FAQ.

Regards