We have an events spread sheet listing facility usage by date. Showing room
number, time, who, event, and such. Is it possible to have the expired
rows€¦€�any date past the computers present date€� automatically moved to
another sheet rather than manually deleting past events? Thanks for your
help to this new excel user. Doug

Here is some code to do what you want...

Private Const intDateColumn As Integer = 2

Public Sub MovePastRecords()
Dim wksCurrent As Worksheet
Dim wksPast As Worksheet
Dim rngCurrent As Range
Dim rngPast As Range
Dim blnCopyRow As Boolean

Set wksCurrent = Sheets("Current")
Set wksPast = Sheets("Past")
Set rngCurrent = wksCurrent.Range("A65535").End(xlUp)
Set rngPast = wksPast.Range("A65535").End(xlUp).Offset(1, 0)

Do While rngCurrent.Row 1
If rngCurrent.Offset(0, intDateColumn - 1).Value < Date Then
blnCopyRow = True
Set rngCurrent = rngCurrent.Offset(-1, 0)
If blnCopyRow = True Then
rngCurrent.Offset(1, 0).EntireRow.Copy rngPast
rngCurrent.Offset(1, 0).EntireRow.Delete
Set rngPast = rngPast.Offset(1, 0)
End If
Loop

End Sub

It makes a few assumptions where you will need to make modifications.
intDateColumn at the top need to be the number of the column where the dates
are. Currently it is 2 which is equivalent to column B.
Set wksCurrent = Sheets("Current")
Set wksPast = Sheets("Past")
You need to change "Current" to the name of the sheet where the current
events are currently stored. You need to change "Past" to the name of the
sheet where you want to archive the expired events.

HTH

"Excel Challenged" wrote:

We have an events spread sheet listing facility usage by date. Showing room
number, time, who, event, and such. Is it possible to have the expired
rows€¦€�any date past the computers present date€� automatically moved to
another sheet rather than manually deleting past events? Thanks for your
help to this new excel user. Doug

Before someone else pick it out I missed one line in my previously posted
solution...
Here is the new sub...

Private Const intDateColumn As Integer = 2

Public Sub MovePastRecords()
Dim wksCurrent As Worksheet
Dim wksPast As Worksheet
Dim rngCurrent As Range
Dim rngPast As Range
Dim blnCopyRow As Boolean

Set wksCurrent = Sheets("Current")
Set wksPast = Sheets("Past")
Set rngCurrent = wksCurrent.Range("A65535").End(xlUp)
Set rngPast = wksPast.Range("A65535").End(xlUp).Offset(1, 0)

Do While rngCurrent.Row 1
If rngCurrent.Offset(0, intDateColumn - 1).Value < Date Then
blnCopyRow = True
Set rngCurrent = rngCurrent.Offset(-1, 0)
If blnCopyRow = True Then
rngCurrent.Offset(1, 0).EntireRow.Copy rngPast
rngCurrent.Offset(1, 0).EntireRow.Delete
Set rngPast = rngPast.Offset(1, 0)
End If
blnCopyRow = False '***New line originally missed
Loop

End Sub

"Excel Challenged" wrote:

We have an events spread sheet listing facility usage by date. Showing room
number, time, who, event, and such. Is it possible to have the expired
rows€¦€�any date past the computers present date€� automatically moved to
another sheet rather than manually deleting past events? Thanks for your
help to this new excel user. Doug

Thank You Jim...
Please excuse my low level of understanding i am just trying to help a
secretary. Question is where do i need to insert this code you have
generously shared? Thanks Doug
--
Thanks Doug


"Jim Thomlinson" wrote:

Before someone else pick it out I missed one line in my previously posted
solution...
Here is the new sub...

Private Const intDateColumn As Integer = 2

Public Sub MovePastRecords()
Dim wksCurrent As Worksheet
Dim wksPast As Worksheet
Dim rngCurrent As Range
Dim rngPast As Range
Dim blnCopyRow As Boolean

Set wksCurrent = Sheets("Current")
Set wksPast = Sheets("Past")
Set rngCurrent = wksCurrent.Range("A65535").End(xlUp)
Set rngPast = wksPast.Range("A65535").End(xlUp).Offset(1, 0)

Do While rngCurrent.Row 1
If rngCurrent.Offset(0, intDateColumn - 1).Value < Date Then
blnCopyRow = True
Set rngCurrent = rngCurrent.Offset(-1, 0)
If blnCopyRow = True Then
rngCurrent.Offset(1, 0).EntireRow.Copy rngPast
rngCurrent.Offset(1, 0).EntireRow.Delete
Set rngPast = rngPast.Offset(1, 0)
End If
blnCopyRow = False '***New line originally missed
Loop

End Sub

"Excel Challenged" wrote:

We have an events spread sheet listing facility usage by date. Showing room
number, time, who, event, and such. Is it possible to have the expired
rows€¦€�any date past the computers present date€� automatically moved to
another sheet rather than manually deleting past events? Thanks for your
help to this new excel user. Doug

No problem... Make sure that your macro security setting is medium(on any
computers that will run this code. Tools - Macros - Security). This code
can be placed in a number of different spots. If it were me here is how I
would do it. I would insert a new sheet called something like Data Summary or
Start or whatever... This is the sheet where you will put any stats about
your data or whatever else including any buttons to manipulate the data. Here
is where the propeller head stuff begins...

Click on Tools - Customize and select the toolbars tab.
Check off Control Toolbox and then Ok.
A new toolbar will open up. On that toolbar there will be a little button
icon.
Click the button Icon.
On the sheet Drag the cross-hair to draw a button... (Tada. You have created
your first button)

Right click on the button you have just created and select properties.
Where it says (Name) change CommandButton1 to cmdArchive
Where it says Caption change CommandButton1 to Archive (the text on the
button will now read Archive)
Close the properties dialogue
Right click on the button again and select view code
You will see something like this

Private Sub cmdArchive_Click()

End Sub

change it to this

Private Sub cmdArchive_Click()
Call MovePastRecords
End Sub

and now paste the other code at the bottom of the code window. You are just
about done. Go back to the spread sheet and on the Control Toolbox click the
icon that looks kind of like a "pencil and ruler and triangle". Your button
should now be fully functional and ready to go...

HTH

"Doug M..." wrote:

Thank You Jim...
Please excuse my low level of understanding i am just trying to help a
secretary. Question is where do i need to insert this code you have
generously shared? Thanks Doug
--
Thanks Doug


"Jim Thomlinson" wrote:

Before someone else pick it out I missed one line in my previously posted
solution...
Here is the new sub...

Private Const intDateColumn As Integer = 2

Public Sub MovePastRecords()
Dim wksCurrent As Worksheet
Dim wksPast As Worksheet
Dim rngCurrent As Range
Dim rngPast As Range
Dim blnCopyRow As Boolean

Set wksCurrent = Sheets("Current")
Set wksPast = Sheets("Past")
Set rngCurrent = wksCurrent.Range("A65535").End(xlUp)
Set rngPast = wksPast.Range("A65535").End(xlUp).Offset(1, 0)

Do While rngCurrent.Row 1
If rngCurrent.Offset(0, intDateColumn - 1).Value < Date Then
blnCopyRow = True
Set rngCurrent = rngCurrent.Offset(-1, 0)
If blnCopyRow = True Then
rngCurrent.Offset(1, 0).EntireRow.Copy rngPast
rngCurrent.Offset(1, 0).EntireRow.Delete
Set rngPast = rngPast.Offset(1, 0)
End If
blnCopyRow = False '***New line originally missed
Loop

End Sub

"Excel Challenged" wrote:

We have an events spread sheet listing facility usage by date. Showing room
number, time, who, event, and such. Is it possible to have the expired
rows€¦€�any date past the computers present date€� automatically moved to
another sheet rather than manually deleting past events? Thanks for your
help to this new excel user. Doug

Jim...
Thanks for the code. We followed direction by the way thank you but have a
compile error which says Only comments may appear after End Sub, End
Function, or End Property. The words Private Const are highlited. When i
removed that line the next compile error was Loop without Do. So i put it
back in and am asking any ideas? Thanks Doug

Private Sub cmdArchive_Click()
Call MovePastRecords

End Sub


Private Const intDateColumn As Integer = 1

Public Sub MovePastRecords()
Dim wksCurrent As Worksheet
Dim wksPast As Workshe

I am getting hte same message and would really love to use this code, did you
ever get an answer from Jim to how to fix it or left in limbo, is there
someone out there who can help



"Doug M..." wrote:

Jim...
Thanks for the code. We followed direction by the way thank you but have a
compile error which says Only comments may appear after End Sub, End
Function, or End Property. The words Private Const are highlited. When i
removed that line the next compile error was Loop without Do. So i put it
back in and am asking any ideas? Thanks Doug

Private Sub cmdArchive_Click()
Call MovePastRecords

End Sub


Private Const intDateColumn As Integer = 1

Public Sub MovePastRecords()
Dim wksCurrent As Worksheet
Dim wksPast As Workshe