Solved: Move Files to New Directory Yearly and Save as YYYY

[noobie]

Hi all,

I have a cross post at Ozgrid for this thread. Figured out should post it here since I found some relatvely close solutions here.

My post in Ozgrid : http://www.ozgrid.com/forum/showthread.php?t=61277

I found this thread which is close to what I want : http://www.vbaexpress.com/forum/show...ight=directory

I've this very complex macro which I hope a kind soul would help me figure out. I've a master sheet called records. It consolidates all the data from various worksheets. Overtime, the lists gets very long. So I'm proposing this.

I want a macro which -

Shift all the data yearly into a new directory at

G:\MMT\PM\Various\Stock\Archive. When it saves at this directory it should bear the year as the folder name. The dates are retrieved from column H.

- it should be operated at the every end of the year


Sorry this seems complex. And i don't know whether it's even possible.

But your response or suggestions on alternatives are very munch appreciated.

noobie.

[Simon Lloyd]

Without your workbook or more information i can only provide this solution.
[VBA]
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim lDat_ThisYear As Date
Dim lDat_YearLater As Date
Dim sStr As String
Dim myattr
With ThisWorkbook
'Check ReadOnly status to establish if
'this is a backup copy
If ActiveWorkbook.ReadOnly Then Exit Sub
lDat_Today = Date
If Not Year(lDat_ThisYear) = Year(lDat_YearLater) Then
sStr = "G:\MMT\PM\Various\Stock\Archive" & _
" - " & Format(Now, "dd mm yyyy") & ".xls"
On Error Resume Next
SaveCopyAs sStr
On Error GoTo 0
SetAttr sStr, vbReadOnly
End If
End With
End Sub

[/VBA]this will save the workbook when it becomes a year old to the folder you specified!

Regards,
SImon

[noobie]

Hi,

I tried your code. But nothing comes up. Maybe I've not provided you with enough information. Anyway, I tried studying your code. but I can't really figure out due to my lack of knowledge.

I was wondering if it
- does check for the dates at column G and save it to their respective year folders in the given directory
-Does it only save at the end of the year? As in only on every 31st Dec?



Many thanks in advance.

[Simon Lloyd]

Noobie please post your workbook as the picture does not allow to manipulate any data or give us a true representation of what you are trying to achieve!

From your thread title i assumed you wanted the workbook to save once a year, if this isnt so please explain exactly what it is you would like to achieve as at the moment it is very sketchy!

Regards,
Simon

[Charlize]

- Which version of excel ? xp, 2003
- store day, month and year in a seperate variable
- check day is 31 and month 12 (could do this with a before close)
- if so
- create path + year and store file.

Charlize

[Charlize]

Possible way to go ? Try it before changing system date to 31th of december and try it again when changed to 31/12.

[VBA]Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim v_day As String
Dim v_month As String
Dim v_year As String
v_day = CStr(Day(Date))
v_month = CStr(Month(Date))
v_year = CStr(Year(Date))
If v_day = "31" And v_month = "12" Then
MsgBox ("Time to save to archive for year : " & v_year & vbCrLf & _
"Maybe check if directory exists, create it and save as copy and" & vbCrLf & _
"keep original file ...")
Else
MsgBox ("No saving to archive copy")
End If
End Sub[/VBA]
Charlize

[Charlize]

Or do you want to save only the data based on the value in column G. So everything with 2004, 2005, 2006, ... would be in a seperate directory.

Charlize

[noobie]

Sorry for not being able to reply promptly. I was out of office. In addition, I want to aplogized for not posting this link at Ozgrid because I had to rush out of the office after posting the first post. And somehow I forgot to post the link.

Anyhow,

I wish to clarify some stuff.

- I wish to move the data only when the date is 31 and month is 12.
-Only move the data in the current year
- the date column can be found at column H.
- I want it move and not copied

Here's an example,

when the date is 31/12/2006, it should move all the data in year 2006 and save in the directory (G:\MMT\PM\Various\Stock\Archive) under folder 2006.


I'm sorry for the inconvience caused. And my lack of constant replies.

However, Thanks alot of your above suggestions.

[Charlize]

Column H ? According to your picture it's G.

- apply custom filter on column G saying >= 01/01/2006 and <= 31/12/2006
- copy visible rows to another sheet
- save this sheet in your directory as workbook
- remove sheet used for copying
- remove visible rows

Make a back-up before trying something. Have you got something already or are you doing it from scratch ?

Charlize

[Charlize]

Not finished yet, but it gives an idea how you could do it. Next thing is to save sheet2 as a seperate workbook. Try it first on some bogus data.

[VBA]Sub test_archiving()
Dim v_day As String
Dim v_month As String
Dim v_year As String
Dim norows As Long
Dim archiving As Long
Dim pos As Long
Dim lrow As Long
norows = Range("G" & Rows.Count).End(xlUp).Row
pos = 2
v_day = CStr(Day(Date))
v_month = CStr(Month(Date))
v_year = CStr(Year(Date))
If v_day = "31" And v_month = "12" Then
On Error Resume Next
MsgBox ("Time to save to archive for year : " & v_year & vbCrLf & _
"Maybe check if directory exists, create it and save as copy and" & vbCrLf & _
"keep original file ...")
ChDir ("C:\Data\" & v_year)
If Err.Number = 76 Then
MkDir ("C:\Data\" & v_year)
End If
Sheets(1).Range("A1:G1").Copy Sheets(2).Range("A1:G1")
For archiving = 2 To norows
If CStr(Year(Range("G" & pos).Value)) = v_year Then
lrow = Sheets(2).Range("G" & Rows.Count).End(xlUp).Row
Range("A" & pos & ":G" & pos).Copy Sheets(2).Range("A" & lrow + 1 & ":G" & lrow + 1)
pos = pos + 1
End If
Next archiving
pos = 2
For archiving = 2 To norows
If CStr(Year(Range("G" & pos).Value)) = v_year Then
Range("A" & pos & ":G" & pos).Delete
norows = norows - 1
Else
pos = pos + 1
End If
Next archiving
Else
MsgBox ("No saving to archive copy")
End If
End Sub
[/VBA]
Charlize

[Charlize]

Or you could use a model workbook. For example archiving.xls and use that to copy the desired rows and saving to archive directory.
with [VBA]workbooks.open("archiving.xls")[/VBA] you could open the archiving model. After filling the model you could save to desired directory with different name and close without saving original archiving workbook.

Charlize

[noobie]

Hi Charlize,

Thanks very much for your reply.

tried your macro. And it worked like what I wanted it to be.
But one thing..

How do i save in a workbook instead of a sheet? and place it in Archive2006?

Which means, I hope that for every 31/12/YY, the data would be saved in a workbook 20YY under folder 20YY .

Pls advise me.

Thanks so much for your follow up.

[Charlize]

A little changing in coding to save to new workbook.
[vba]Sub test_archiving()
'new workbook to save to
Dim wb As Workbook
'the active workbook with data in it
Dim current As Workbook
'day, month, year
Dim v_day As String
Dim v_month As String
Dim v_year As String
'no of rows in current workbook
Dim norows As Long
'a loop counter
Dim archiving As Long
'rowno to copy
Dim pos As Long
'row to copy to in new workbook
Dim lrow As Long
Set current = ThisWorkbook
Set wb = Workbooks.Add
current.Activate
norows = Range("G" & Rows.Count).End(xlUp).Row
pos = 2
v_day = CStr(Day(Date))
v_month = CStr(Month(Date))
v_year = CStr(Year(Date))
If v_day = "31" And v_month = "12" Then
On Error Resume Next
MsgBox ("Time to save to archive for year : " & v_year & vbCrLf & _
"Maybe check if directory exists, create it and save as copy and" & vbCrLf & _
"keep original file ...")
ChDir ("C:\Data\" & v_year)
If Err.Number = 76 Then
MkDir ("C:\Data\" & v_year)
End If
Sheets(1).Range("A1:G1").Copy wb.Sheets(1).Range("A1:G1")
For archiving = 2 To norows
If CStr(Year(Range("G" & pos).Value)) = v_year Then
lrow = wb.Sheets(1).Range("G" & Rows.Count).End(xlUp).Row
Range("A" & pos & ":G" & pos).Copy wb.Sheets(1).Range("A" & lrow + 1 & ":G" & lrow + 1)
pos = pos + 1
End If
Next archiving
pos = 2
For archiving = 2 To norows
If CStr(Year(Range("G" & pos).Value)) = v_year Then
Range("A" & pos & ":G" & pos).Delete
norows = norows - 1
Else
pos = pos + 1
End If
Next archiving
wb.SaveAs Filename:="C:\Data\" & v_year & "\archive.xls"
wb.Close
Else
wb.Close
MsgBox ("No saving to archive copy")
End If
End Sub
[/vba]
Charlize

[noobie]

Hi.

Thanks. It worked like what I wanted it to be.

Sorry for the inconvenience caused along the way. But I'm glad u stood by and helped me thru.

[Charlize]

You could combine the two loops into one. When you've got a bit more data, the code only needs to run once through your rows.
[VBA]'some code above
For archiving = 2 To norows
If CStr(Year(Range("G" & pos).Value)) = v_year Then
lrow = wb.Sheets(1).Range("G" & Rows.Count).End(xlUp).Row
Range("A" & pos & ":G" & pos).Copy wb.Sheets(1).Range("A" & lrow + 1 & ":G" & lrow + 1)
Range("A" & pos & ":G" & pos).Delete
norows = norows - 1
Else
pos = pos + 1
End If
Next archiving
'some code below. The saving of wb, ...
[/VBA]Charlize

[noobie]

Thanks so much for your help. I really appreciate it. After working it all out, i'll reply.

[Aussiebear]

G'day Charlize, This concept would make a great KB entry if you were of the mind to do so. I too would like to use the concept to auto save each years data as a folder named for the year just passed.

Ted

[noobie]

Hi Charlize,
In reference to the macro you posted, it worked well. And I'm really thankful. I guess this post will be pretty useful for many other users. So it would be nice to see you write a KBentry.

Thanks alot for your help.

Wishing u a blessed christmas in advance.

Noobie

[ETracker]

Hi Charlize,

This is great archiving code, I have been thinking about this for a while and not that it is going on 2007, I will need to basic do the same thing.

Thanks for you input, I am sure there will be a lot of other people that will be using this for the files.

Also thanks to noobie for asking the question.

ETracker

[lucas]

Ok, I have been following this thread for a while and I still don't understand the attraction of automating something that you do once a year.......

Charlize and Simon have contributed good code towards a solution and it's interesting but......once a year???? sorry but I couldn't resist.