saving workbook to destination file automatically

[mikespeck]

Hi,
I'm looking to rename and save my workbook to a destination file everday at a preset time. After it saves to the destination file i need all the data to be removed from the origional workbook.

Lets say I'm working with a workbook called Book1 everyday at lets say 3:00 p.m. it saves that Workbook to a destination file along with todays date. Example Book1_8_21_06. Then once saved all data is removed from the origional workbook.

Is this acheivable?

Mike

[JLatham]

Indeed, its doable, question is have you absolutely thought everything out -
you say you want to delete all information in the workbook after it's saved -
are you sure about that? Or are there column headers, info text, formulas,
etc that need to be left in place?
Also, you'd probably want to rename the workbook a second time after having
saved it with the data, because it's going to keep that name and if someone
comes along and saves it, then the original data saved is gone.

If this is a totally automated thing, look into setting up a perpetual loop
inside of either the Workbook_Open() or Worksheet_Activate() events to simply
check the time and when it is at (or after, hard to hit an exact time) then
do the rename, save, cleanup, and rename again functions. Probably only want
to set your timer for about every 10 or 20 minutes within the function to
keep from stealing too much time from the primary purpose of the workbook.

"mikespeck" wrote:

>
> Hi,
> I'm looking to rename and save my workbook to a destination file
> everday at a preset time. After it saves to the destination file i need
> all the data to be removed from the origional workbook.
>
> Lets say I'm working with a workbook called Book1 everyday at lets say
> 3:00 p.m. it saves that Workbook to a destination file along with
> todays date. Example Book1_8_21_06. Then once saved all data is
> removed from the origional workbook.
>
> Is this acheivable?
>
> Mike
>
>
> --
> mikespeck
> ------------------------------------------------------------------------
> mikespeck's Profile: http://www.excelforum.com/member.php...o&userid=34946
> View this thread: http://www.excelforum.com/showthread...hreadid=573762
>
>

[mikespeck]

Maybe I didn't explain everything fully. I have data comeing into row 3 automatically throught an opc server. I have vba written so that everytime new data comes in on row three the old data keeps dropping down through the rows. Well as everyone knows excell starts to get sloggish with more and more data comeing in. What I would like to do is save the entire workbook, under todays date, at a certain time of the day. Then on the origional workbook clear all the data from rows 4 and down. Then on the next day at the preset time save the workbook again with the date. Can someone add to my code to have this possible? I've enclosed the code below..
Thanks,
Mike


Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A3").Value <> 1 Then
Exit Sub
End If
If Not Intersect(Range(Target.Address), Me.Range("A3")) _
Is Nothing Then
Me.Cells(Me.Range("A:A").Rows.Count, Target.Column).Clear
Dim rgOldValues As Range
Dim iLastRow As Long
iLastRow = Me.Cells(Columns(Target.Column).Rows.Count, Target.Column) _
.End(xlUp).row
Application.EnableEvents = False
Select Case iLastRow
Case 1
Case 2
Case 3
Range("A4:H4").Value = Range("A3:H3").Value
Range("C4").Value = Now
Cells(4, Target.Column).Value = Cells(3, Target.Column).Value
Case Else
vaOldValues = Me.Range("A4:H" & _
IIf(iLastRow = 4, 5, iLastRow))
Range("A5:H5").Resize(UBound(vaOldValues, 1), 6).Value = _
vaOldValues
Range("A4:H4").Value = Range("A3:H3").Value
Range("C4").Value = Now
Set rgOldValues = Me.Range(Cells(Target.row + 2, Target.Column), _
Cells(iLastRow, Target.Column))
Cells(4, Target.Column).Value = Cells(3, Target.Column).Value
End Select
Application.EnableEvents = True
End If
Exit Sub
End Sub

[JLatham]

Thanks for the clarification. That makes things much easier to deal with in
coming up with a solution for you. I'll be looking at this later, have to
rush off right now, and quite possibly someone else will add the few lines to
your existing code needed to accomplish this before I even get back. It's
actually probably only going to be about half-a-dozen lines of code or so.

"mikespeck" wrote:

>
> Maybe I didn't explain everything fully. I have data comeing into row 3
> automatically throught an opc server. I have vba written so that
> everytime new data comes in on row three the old data keeps dropping
> down through the rows. Well as everyone knows excell starts to get
> sloggish with more and more data comeing in. What I would like to do is
> save the entire workbook, under todays date, at a certain time of the
> day. Then on the origional workbook clear all the data from rows 4 and
> down. Then on the next day at the preset time save the workbook again
> with the date. Can someone add to my code to have this possible? I've
> enclosed the code below..
> Thanks,
> Mike
>
>
> Private Sub Worksheet_Change(ByVal Target As Range)
> If Range("A3").Value <> 1 Then
> Exit Sub
> End If
> If Not Intersect(Range(Target.Address), Me.Range("A3")) _
> Is Nothing Then
> Me.Cells(Me.Range("A:A").Rows.Count, Target.Column).Clear
> Dim rgOldValues As Range
> Dim iLastRow As Long
> iLastRow = Me.Cells(Columns(Target.Column).Rows.Count, Target.Column)
> _
> .End(xlUp).row
> Application.EnableEvents = False
> Select Case iLastRow
> Case 1
> Case 2
> Case 3
> Range("A4:H4").Value = Range("A3:H3").Value
> Range("C4").Value = Now
> Cells(4, Target.Column).Value = Cells(3, Target.Column).Value
> Case Else
> vaOldValues = Me.Range("A4:H" & _
> IIf(iLastRow = 4, 5, iLastRow))
> Range("A5:H5").Resize(UBound(vaOldValues, 1), 6).Value = _
> vaOldValues
> Range("A4:H4").Value = Range("A3:H3").Value
> Range("C4").Value = Now
> Set rgOldValues = Me.Range(Cells(Target.row + 2, Target.Column), _
> Cells(iLastRow, Target.Column))
> Cells(4, Target.Column).Value = Cells(3, Target.Column).Value
> End Select
> Application.EnableEvents = True
> End If
> Exit Sub
> End Sub
>
>
> --
> mikespeck
> ------------------------------------------------------------------------
> mikespeck's Profile: http://www.excelforum.com/member.php...o&userid=34946
> View this thread: http://www.excelforum.com/showthread...hreadid=573762
>
>

[JLatham]

"mikespeck" wrote:

>
> Maybe I didn't explain everything fully. I have data comeing into row 3
> automatically throught an opc server. I have vba written so that
> everytime new data comes in on row three the old data keeps dropping
> down through the rows. Well as everyone knows excell starts to get
> sloggish with more and more data comeing in. What I would like to do is
> save the entire workbook, under todays date, at a certain time of the
> day. Then on the origional workbook clear all the data from rows 4 and
> down. Then on the next day at the preset time save the workbook again
> with the date. Can someone add to my code to have this possible? I've
> enclosed the code below..
> Thanks,
> Mike
>
>
> Private Sub Worksheet_Change(ByVal Target As Range)
> If Range("A3").Value <> 1 Then
> Exit Sub
> End If
> If Not Intersect(Range(Target.Address), Me.Range("A3")) _
> Is Nothing Then
> Me.Cells(Me.Range("A:A").Rows.Count, Target.Column).Clear
> Dim rgOldValues As Range
> Dim iLastRow As Long
> iLastRow = Me.Cells(Columns(Target.Column).Rows.Count, Target.Column)
> _
> .End(xlUp).row
> Application.EnableEvents = False
> Select Case iLastRow
> Case 1
> Case 2
> Case 3
> Range("A4:H4").Value = Range("A3:H3").Value
> Range("C4").Value = Now
> Cells(4, Target.Column).Value = Cells(3, Target.Column).Value
> Case Else
> vaOldValues = Me.Range("A4:H" & _
> IIf(iLastRow = 4, 5, iLastRow))
> Range("A5:H5").Resize(UBound(vaOldValues, 1), 6).Value = _
> vaOldValues
> Range("A4:H4").Value = Range("A3:H3").Value
> Range("C4").Value = Now
> Set rgOldValues = Me.Range(Cells(Target.row + 2, Target.Column), _
> Cells(iLastRow, Target.Column))
> Cells(4, Target.Column).Value = Cells(3, Target.Column).Value
> End Select
> Application.EnableEvents = True
> End If
> Exit Sub
> End Sub
>
>
> --
> mikespeck
> ------------------------------------------------------------------------
> mikespeck's Profile: http://www.excelforum.com/member.php...o&userid=34946
> View this thread: http://www.excelforum.com/showthread...hreadid=573762
>
>

[JLatham]

Trying again - sorry if ends up semi-duplicate posting.

Try putting this code inside of your current _Change() event handler. Down
near the bottom, probably just ahead of the Exit Sub statement would be a
good place (after that statement wouldn't do much good <g>).

Change the line defining the time of day for the save to be whatever time
you want it to be.

'variables for the workbook save operations
Dim originalFullName As String
Dim newFullName As String
Dim TimeToSave As Date ' date/time

TimeToSave = "10:30:00 AM" ' change as you want
'put this somewhere down inside of your current _Change code
If Format(Now(), "hh:mm") > TimeToSave Then
originalFullName = ThisWorkbook.FullName
newFullName = Left(originalFullName, Len(originalFullName) -
Len(ThisWorkbook.Name))
newFullName = newFullName & Left(ThisWorkbook.Name,
InStr(ThisWorkbook.Name, ".xls") - 1)
newFullName = newFullName & "_" & Month(Now()) & "_" & Day(Now()) &
"_" & Right(Year(Now()), 2) & ".xls"
If Dir(newFullName) = "" Then
' haven't done this yet, so do it now
Application.DisplayAlerts = False
'save with the new name
ActiveWorkbook.SaveAs Filename:=newFullName
'clear out the existing data
If Selection.SpecialCells(xlCellTypeLastCell).Row > 3 Then
Rows("4:" &
Selection.SpecialCells(xlCellTypeLastCell).Row).Select
Selection.Delete shift:=xlUp
Range("A3").Select
End If
'revert to the old name
ActiveWorkbook.SaveAs Filename:=originalFullName
Application.DisplayAlerts = True
End If
End If

What it does: if the current time is later than the time you've coded into
it, then it creates a new filename (for use in same folder) and tests to see
if that file already exists, if it does not exist, saves current workbook
with the new name, clears out any information in rows 4:n, where n is last
row used, and then gives the workbook its original name back.

If the modified file already exists in the folder, then it none of this
happens - waits until the next day to write another copy.

I split the build up of the new file name over 3 instructions, just to keep
line breaks here in the forum to a minimum, obviously those could be written
as a single instruction.
"mikespeck" wrote:

>
> Maybe I didn't explain everything fully. I have data comeing into row 3
> automatically throught an opc server. I have vba written so that
> everytime new data comes in on row three the old data keeps dropping
> down through the rows. Well as everyone knows excell starts to get
> sloggish with more and more data comeing in. What I would like to do is
> save the entire workbook, under todays date, at a certain time of the
> day. Then on the origional workbook clear all the data from rows 4 and
> down. Then on the next day at the preset time save the workbook again
> with the date. Can someone add to my code to have this possible? I've
> enclosed the code below..
> Thanks,
> Mike
>
>
> Private Sub Worksheet_Change(ByVal Target As Range)
> If Range("A3").Value <> 1 Then
> Exit Sub
> End If
> If Not Intersect(Range(Target.Address), Me.Range("A3")) _
> Is Nothing Then
> Me.Cells(Me.Range("A:A").Rows.Count, Target.Column).Clear
> Dim rgOldValues As Range
> Dim iLastRow As Long
> iLastRow = Me.Cells(Columns(Target.Column).Rows.Count, Target.Column)
> _
> .End(xlUp).row
> Application.EnableEvents = False
> Select Case iLastRow
> Case 1
> Case 2
> Case 3
> Range("A4:H4").Value = Range("A3:H3").Value
> Range("C4").Value = Now
> Cells(4, Target.Column).Value = Cells(3, Target.Column).Value
> Case Else
> vaOldValues = Me.Range("A4:H" & _
> IIf(iLastRow = 4, 5, iLastRow))
> Range("A5:H5").Resize(UBound(vaOldValues, 1), 6).Value = _
> vaOldValues
> Range("A4:H4").Value = Range("A3:H3").Value
> Range("C4").Value = Now
> Set rgOldValues = Me.Range(Cells(Target.row + 2, Target.Column), _
> Cells(iLastRow, Target.Column))
> Cells(4, Target.Column).Value = Cells(3, Target.Column).Value
> End Select
> Application.EnableEvents = True
> End If
> Exit Sub
> End Sub
>
>
> --
> mikespeck
> ------------------------------------------------------------------------
> mikespeck's Profile: http://www.excelforum.com/member.php...o&userid=34946
> View this thread: http://www.excelforum.com/showthread...hreadid=573762
>
>

[mikespeck]

I'm not very good at this VBA code stuff but it looks to me that there may be some errors, and I would'nt know where to begin. However when I load your code in VBA the following line are red......

newFullName = Left(originalFullName, Len(originalFullName) -
Len(ThisWorkbook.Name))
newFullName = newFullName & Left(ThisWorkbook.Name,
InStr(ThisWorkbook.Name, ".xls") - 1)
newFullName = newFullName & "_" & Month(Now()) & "_" & Day(Now()) &
"_" & Right(Year(Now()), 2) & ".xls"




Rows("4:" &
Selection.SpecialCells(xlCellTypeLastCell).Row).Se lect



Thanks for your help,
Mike

[mikespeck]

Got It, this code works perfectly, I appreciate all the help.