Calculating Date Ranges and Weight Totals
 

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

Calculating Date Ranges and Weight Totals
 

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

"John Walker" wrote in message
...
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

Calculating Date Ranges and Weight Totals
 

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

Calculating Date Ranges and Weight Totals
 

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

Calculating Date Ranges and Weight Totals
 

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

"somethinglikeant" wrote:

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

Calculating Date Ranges and Weight Totals
 

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

"somethinglikeant" wrote:

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