Filtering Multiple Worksheet Columns

[Chris Hankin]

Hello,

Could someone please help me with the following for Excel 2003?

I am trying to modify the following code shown below:

My worksheet is named: DPC Expenses. I wish to create a macro filter
that prompts the user for the following:

Date range - Start Date and End Date (eg 01 - 31 Jan 07) and
Cost Element Code (eg 21008, 21019,
21452, 21097 etc...) and
DPC Holder (eg Joe Bloggs)and
Paid (Y/N) (eg Y, N).

After the user has entered the required
information, the filter will need to look up column I (the Cost column)
and add up all the costs that are filtered.

The Date Ordered column is column B. The DPC Holder column is column J.
The Cost Element Code column is column K. The Cost column is column I.
The Paid (Y/N) column is column M.

I wish the output to be shown on another worksheet named: Query (which
is in the same workbook).

On the Query wooksheet, the user should see
the date range, the DPC Holder, Cost Element Code and Paid (Y/N) values
entered and the total cost.

Sub Query()
Dim dtStart As Date
Dim dtEnd As Date
Dim aCode As String
Dim dpcCode As String
Dim iEnd As Long
Dim dSum As Double
Dim c As Range
Dim d As Range
Dim rng As Range
Dim ws As Worksheet

Set ws = Sheets("DPC Expenses")
ws.Activate
iEnd = ws.Range("B8").End(xlDown).Row
Set rng = ws.Range("B8:B" & iEnd)

dtStart = InputBox("Enter start date (dd-mmm-yy).")
dtEnd = InputBox("Enter end date (dd-mmm-yy).")
aCode = InputBox("Enter CEC code. Leave blank for all.")
dpcCode = InputBox("Enter DPC code. Leave blank for all.")

For Each c In rng
If c >= dtStart And c <= dtEnd Then
If aCode = "" Then dSum = dSum + c.Offset(0, 7)
If aCode = c.Offset(0, 9) Then dSum = dSum + c.Offset(0, 7)
End If
Next c

For Each d In rng
If d >= dtStart And d <= dtEnd Then
If dpcCode = "" Then dSum = dSum + d.Offset(0, 7)
If dpcCode = d.Offset(0, 8) Then dSum = dSum + d.Offset(0, 7)
End If
Next d

Sheets("Query").Range("A2") = dtStart
Sheets("Query").Range("B2") = dtEnd
If aCode = "" Then
Sheets("Query").Range("C2") = "all"
Else
Sheets("Query").Range("C2") = aCode
End If
If dpcCode = "" Then
Sheets("Query").Range("D2") = "all"
Else
Sheets("Query").Range("D2") = dpcCode
End If
Sheets("Query").Range("E2") = dSum
Sheets("Query").Activate
End Sub

Any help on this would be greatly appreciated.

Kind regards,

Chris.

Live Long and Prosper

 

[Chris Hankin]

Hi everyone,

For some reason my post is not attracting any replies. I understand
that this newsgroup is very busy and there are many posts submitted each
day. People like Merjet and Tom do an outstanding job with all their
help and replies and I certainly appreciate their efforts in helping
newbies like me.

I would really appreciate some help on this as I am a newbie to Excel
macros and I need this for work purposes.

Any help would be terrific,

Many thanks in advance,

Chris

Live Long and Prosper

 

[merjet]

Sub Query()
Dim dtStart As Date
Dim dtEnd As Date
Dim aHolder As String
Dim dpcCode As String
Dim aPaid As String
Dim iEnd As Long
Dim dSum As Double
Dim c As Range
Dim rng As Range
Dim ws As Worksheet
Dim bMult As Byte

Set ws = Sheets("DPC Expenses")
ws.Activate
iEnd = ws.Range("B3").End(xlDown).Row
Set rng = ws.Range("B3:B" & iEnd)

dtStart = InputBox("Enter start date (dd-mmm-yy).")
dtEnd = InputBox("Enter end date (dd-mmm-yy).")
aHolder = InputBox("Enter Holder. Leave blank for all.")
dpcCode = InputBox("Enter DPC code. Leave blank for all.")
aPaid = InputBox("Paid? Enter Y, N, or leave blank for either.")

For Each c In rng
If c >= dtStart And c <= dtEnd Then
bMult = 1 'assume row included; set to 0 if not
If aHolder <> "" And c.Offset(0, 8) <> aHolder Then bMult = 0
If dpcCode <> "" And c.Offset(0, 9) <> dpcCode Then bMult = 0
If aPaid <> "" And c.Offset(0, 11) <> aPaid Then bMult = 0
dSum = dSum + bMult * c.Offset(0, 7)
End If
Next c

Sheets("Query").Range("A2") = dtStart
Sheets("Query").Range("B2") = dtEnd
If aHolder = "" Then
Sheets("Query").Range("C2") = "all"
Else
Sheets("Query").Range("C2") = aHolder
End If
If dpcCode = "" Then
Sheets("Query").Range("D2") = "all"
Else
Sheets("Query").Range("D2") = dpcCode
End If
Sheets("Query").Range("E2") = dSum
If aPaid = "" Then
Sheets("Query").Range("F2") = "Y or N"
Else
Sheets("Query").Range("F2") = aPaid
End If
Sheets("Query").Activate
End Sub

Merjet

 

[Longbow]

Thanks very much Merjet - fantastic work - really appreciated.

I tested your code and it works very well.

Cheers,

Chris.

Live Long and Prosper