Adding the next month to a daily volume tracking sheet.

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

mjmcevoy - 20 May 2008 16:33 GMT

Hello,

I’m trying to automate a tedious task at work but I’m not sure how to go
about it.

We track daily volumes on a spreadsheet.

Column 1 would have each business day for the month. Column 2 through 8
would have various volumes for different items that we enter each day. This
piece can’t be automated do to the source of the volumes but what I would
like to automate is adding the next month to the top of the sheet and moving
the previous month down. I cant simply copy and paste the previous month
because the number of business days in each month varies. I would also like
to add the busness days.

The thing that makes this so tedious is that it has to be done on several
sheets.

Any suggestions would be appreciated.

Mike

Reply to this Message

Mike H. - 20 May 2008 18:05 GMT

This should work, depending on how you have the dates running, ascending or
descending. This will work for ascending. It assumes each A1 is 4/1/08 for
each sheet when you enter a date of 5/1/08

Sub AddMo()
Dim wSheet As Worksheet
Dim NewMonth As Date
Dim NextMonth As Date
Dim Lastmonth As Date
Dim DayInMo As Integer
Dim TheName As String

Let NewMonth = InputBox("Please enter the New Month in MM/DD/YYYY format
please: 05/01/2008, etc.")
Let Lastmonth = DateAdd("m", -1, NewMonth)
Let NextMonth = DateAdd("m", 1, NewMonth)
Let DayInMo = NextMonth - NewMonth

Application.ScreenUpdating = False
For Each wSheet In Worksheets
Let TheName = wSheet.Name
Sheets(TheName).Select
If Cells(1, 1).Value = Lastmonth Then
Rows("1:" & DayInMo).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
For X = 1 To DayInMo
Cells(X, 1).Value = NewMonth + X - 1
Next
Cells(1, 1).Select
End If
Next wSheet

End Sub

> Hello,
>
[quoted text clipped - 17 lines]
>
> Mike

Reply to this Message

mjmcevoy - 20 May 2008 18:20 GMT

Hello Mike,

Thanks for your responce!

Is there any add in that would allow me to add just the dates that fall
between monday - friday?

Thanks,
Mike

> This should work, depending on how you have the dates running, ascending or
> descending. This will work for ascending. It assumes each A1 is 4/1/08 for
[quoted text clipped - 51 lines]
> >
> > Mike

Reply to this Message

Mike H. - 20 May 2008 18:48 GMT

This should do it:

Sub AddMo()
Dim wSheet As Worksheet
Dim NewMonth As Date
Dim NextMonth As Date
Dim Lastmonth As Date
Dim DayInMo As Integer
Dim TheName As String
Dim UsedDays As Integer
Dim DaysUsed(31, 2) As Variant
Dim X As Double
Dim Y As Double

Let NewMonth = InputBox("Please enter the New Month in MM/DD/YYYY format
please: 05/01/2008, etc.")
Let Lastmonth = DateAdd("m", -1, NewMonth)
Let NextMonth = DateAdd("m", 1, NewMonth)
Let DayInMo = NextMonth - NewMonth
For X = 1 To DayInMo
DaysUsed(X, 1) = DateAdd("D", X, NewMonth - 1)
Let TheName = Choose(Weekday(DaysUsed(X, 1)), "Sunday", "Monday",
"Tuesday", "Wednesday", "Thursday", "Friday", "Saturday")
If TheName = "Sunday" Or TheName = "Saturday" Then
DaysUsed(X, 2) = 0
Else
Let UsedDays = UsedDays + 1
DaysUsed(X, 2) = 1
End If
Next

Application.ScreenUpdating = False
For Each wSheet In Worksheets
Let TheName = wSheet.Name
Sheets(TheName).Select
'If Cells(1, 1).Value = Lastmonth Then 'can't use this as 1st may be
Sat or Sunday.
If 1 = 1 Then
Rows("1:" & UsedDays).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Y = 0
For X = 1 To DayInMo
If DaysUsed(X, 2) = 1 Then
Y = Y + 1
Cells(Y, 1).Value = NewMonth + X - 1
End If
Next
Cells(1, 1).Select
End If
Next wSheet

End Sub

> Hello Mike,
>
[quoted text clipped - 61 lines]
> > >
> > > Mike

Reply to this Message

Bernie Deitrick - 20 May 2008 18:30 GMT

Mike,

Try the macro below. It will require setting a reference to atpvbaen.xla. This will put the days
in descending order above the last date given in cell A2. Of course, you can change the order to
Ascending using

For myD = myFD To mySD Step -1

instead of:

For myD = mySD To myFD

HTH,
Bernie
MS Excel MVP

Sub AddNewMonth()
Dim mySD As Date
Dim myFD As Date
Dim myD As Date

mySD = Range("A2").Value + 1
myFD = DateSerial(Year(mySD), Month(mySD) + 2, 0)

For myD = mySD To myFD
If [atpvbaen.xls].WORKDAY(myD - 1, 1) = myD Then
With Range("A2").EntireRow
.Copy 'Optional, if you have formatting or
.Insert
End With
Range("A2").Value = myD
End If
Next myD

End Sub

> Hello,
>
[quoted text clipped - 17 lines]
>
> Mike

Reply to this Message

Bernie Deitrick - 20 May 2008 18:33 GMT

Oops. I should have said atpvbaen.xls, not atovbaen.xla. See

http://www.cpearson.com/excel/ATP.htm

for more.

HTH,
Bernie
MS Excel MVP

> Hello,
>
[quoted text clipped - 17 lines]
>
> Mike

Reply to this Message