Calculating Date Ranges and Weight Totals

[John Walker]

Hi,

I need to write a fairly complicated macro and am hopeful that someone may
have had to do something similar and could give me advice.
The spreadsheet itself is simple, with these columns:

STATE, VENDOR, DATE1, DATE2, WEIGHT.

When the macro is run we would like the user to be able to enter a starting
and ending date. The macro will then go through every row in the worksheet
and figure out how many days between DATE1 and DATE2 fall within the
user-entered starting/ending date range, and will write the results into
column F for each row.

We also need to group the worksheet by STATE/VENDOR, and give a WEIGHT total
at each group break.

Is all this possible to do with a macro? If anyone has any sample code that
would be greatly appreciated.

Thanks in advance,
John

 

[Bill Kuunders]

It needn't be a complicated macro.
The number of days is found by subtracting C from D

To get subtotals you could look at <Data><Subtotals>
Where you can get subtotals per group.

use
at each change in ..........state
use function ..................sum
add subtotal to .............weight

If you do the state subtotals first and then the vendor subtotals AND NOT
thick the option to replace current subtotals.....
You should get what you want.

Greetings from NZ
Bill K

 

[somethinglikeant]

Hi John,

Just working on this now for you.
I had difficulty coding the 4 cases for the date periods.

This code fulfils your first request

:=====
Sub Macro1()

a = InputBox("Enter Start Date")
a = DateValue(a)

b = InputBox("Enter End Date")
b = DateValue(b)

[F2].Select

Do Until IsEmpty(ActiveCell.Offset(0, -1))
x = DateValue(ActiveCell.Offset(0, -3).Value)
y = DateValue(ActiveCell.Offset(0, -2).Value)

If Application.WorksheetFunction.Max(x, y) < _
Application.WorksheetFunction.Max(a, b) Then ActiveCell.Value =
y - a

If Application.WorksheetFunction.Max(x, y) > _
Application.WorksheetFunction.Max(a, b) Then ActiveCell.Value =
b - x

If Application.WorksheetFunction.Max(x, y) < _
Application.WorksheetFunction.Min(a, b) Then ActiveCell.Value =
0

If Application.WorksheetFunction.Min(x, y) > _
Application.WorksheetFunction.Max(a, b) Then ActiveCell.Value =
0
ActiveCell.Offset(1, 0).Select
Loop

End Sub

:==================

i'll work on the next bit

http://www.excel-ant.co.uk

 

[somethinglikeant]

Sub Macro1()

a = InputBox("Enter Start Date")
a = DateValue(a)

b = InputBox("Enter End Date")
b = DateValue(b)

[F2].Select

Do Until IsEmpty(ActiveCell.Offset(0, -1))
x = DateValue(ActiveCell.Offset(0, -3).Value)
y = DateValue(ActiveCell.Offset(0, -2).Value)

If Application.WorksheetFunction.Max(x, y) < _
Application.WorksheetFunction.Max(a, b) Then ActiveCell.Value =
y - a

If Application.WorksheetFunction.Max(x, y) > _
Application.WorksheetFunction.Max(a, b) Then ActiveCell.Value =
b - x

If Application.WorksheetFunction.Max(x, y) < _
Application.WorksheetFunction.Min(a, b) Then ActiveCell.Value =
0

If Application.WorksheetFunction.Min(x, y) > _
Application.WorksheetFunction.Max(a, b) Then ActiveCell.Value =
0
ActiveCell.Offset(1, 0).Select
Loop

[A1].Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

[B2].Select

Do Until IsEmpty(ActiveCell)
x = ActiveCell.Value
y = 0
Do Until ActiveCell.Value <> x
y = y + ActiveCell.Offset(0, 3).Value
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.EntireRow.Insert
ActiveCell.Offset(0, 3).Value = y
ActiveCell.Offset(0, 3).Font.Bold = True
ActiveCell.Offset(1, 0).Select
Loop

End Sub

http://www.excel-ant.co.uk

 

[John Walker]

Great! Thank you. I will try implementing this code into my sheet right now.
Thanks, John

 

[John Walker]

Hey it works! Great, thank you. I may need to do some minor tweaking
because it doesn't seem to grouping properly, but this is exactly what i
needed.
Thanks!
John