We value your feedback.
Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!
Course Of The Month
11 days, 3 hours left to enrollBecome a Premium Member and unlock a new, free course in leading technologies each month.
Solved
Macro to Version Folders within a Folder
Posted on 2013-01-03
EE Pros.;
Greetings! I have a great Macro that Gowflow from EE built out for me that takes a specified set of "Range Names" and copies/pastes the data into a folder that's placed on the desktop. I now have a slightly different requirement which is to "version" a folder within the main desktop folder and still copy (instead of overwrite) the Range Names.
I have attached the original sample that Gowflow and I built out so you can see what this does and how it does it.
Copy-of-Saving-each-Category.xlsm
Greetings! I have a great Macro that Gowflow from EE built out for me that takes a specified set of "Range Names" and copies/pastes the data into a folder that's placed on the desktop. I now have a slightly different requirement which is to "version" a folder within the main desktop folder and still copy (instead of overwrite) the Range Names.
I have attached the original sample that Gowflow and I built out so you can see what this does and how it does it.
Copy-of-Saving-each-Category.xlsm
[X]
Welcome to Experts Exchange
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
- Help others & share knowledge
- Earn cash & points
- Learn & ask questions
15-
10
25 Comments
Active 2 days ago
Gowflow,
When I fire the macro, it moves Excel into a "Not Responding" mode. I waited about two minutes before shutting the program down. Could it be caught in a loop? Have you used it to see if it works on your machine?
B.
When I fire the macro, it moves Excel into a "Not Responding" mode. I waited about two minutes before shutting the program down. Could it be caught in a loop? Have you used it to see if it works on your machine?
B.
Active 2 days ago
Gowflow,
PERFECT! Works like a champ. Will incorporate it into master version now. Thank you for making something complex......simple! Definitely saved me time and effort.
All the best to you,
B.
PERFECT! Works like a champ. Will incorporate it into master version now. Thank you for making something complex......simple! Definitely saved me time and effort.
All the best to you,
B.
Active 1 day ago
My pleasure. If you want I can keep always the last question we have monitored so if you need anything like this time you give me a buzz and will take it from there. I do this with 'selected' users I like to follow-up their projects o if your intrested let me know I will keep you in the list to follow.
Rgds/gowflow
Rgds/gowflow
Active 2 days ago
Gowflow,
I put your code (that works) into my production version ( I had to change C19 and C20 to a single reference B2). I'm having to troubleshoot the Macro since making several slight changes to adapt to the production WB; I'm getting a compile error (see attached picture). The error is taking place on this line:
Then
WBName = CreateWB(Environ("USERPROF
for this specific code reference point: CreateWB
Here is the entire code I now have put in:
Function CreateWB(NewWBPath As String, VerName As String, NewWBName As String, Nam As Name) As String
Dim WS As Worksheet
Dim WSS As Worksheet
Dim NewWb As Workbook
Dim FileSaved As Boolean
Application.DisplayAlerts = False
Application.ScreenUpdating
Set WS = ActiveSheet
Set NewWb = Workbooks.Add
FileSaved = False
Do
On Error Resume Next
NewWb.SaveAs Filename:=NewWBPath & VerName & "\" & Nam.NameLocal, FileFormat:=xlExcel8
Select Case Err
Case 1004
MkDir NewWBPath
MkDir NewWBPath & VerName
On Error GoTo 0
Case 0
FileSaved = True
End Select
Loop Until FileSaved
Nam.RefersToRange.Copy NewWb.Worksheets(1).Range(
NewWb.Worksheets(1).UsedRa
ActiveSheet.Name = NewWBName
For Each WSS In NewWb.Worksheets
If InStr(1, WSS.Name, "Sheet") <> 0 Then WSS.Delete
Next WSS
NewWb.Save
CreateWB = NewWb.FullName
NewWb.Close
Set NewWb = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating
End Function
Sub GetCategories()
Dim I As Long
Dim WS As Worksheet
Dim MaxRow As Long
Dim WBName As String
Dim WBCount As Long
Dim Nam As Name
Dim VerFolder As String
If MsgBox("Are you ready to Create Workbook " & ActiveSheet.Range("C19") & " ?", vbQuestion + vbYesNo, "Send Emails") = vbYes Then
Set WS = ActiveSheet
VerFolder = Format(Now, "yyyymmdd hhmm") & " - " & ActiveSheet.Range("C20")
For Each Nam In Application.Names
If LCase(Left(Nam.Name, 8)) = "category" And LCase(Right(Nam.Name, 6)) = "survey" Then
WBName = CreateWB(Environ("USERPROF
WBCount = WBCount + 1
End If
Next Nam
MsgBox ("A total of " & WBCount & " Workbooks has been saved under worksheet name: " & ActiveSheet.Range("C19") & " successfully on the Desktop under folder " & ActiveSheet.Range("C20"))
End If
End Sub
Any ideas?
b.
Error-in-code.png
I put your code (that works) into my production version ( I had to change C19 and C20 to a single reference B2). I'm having to troubleshoot the Macro since making several slight changes to adapt to the production WB; I'm getting a compile error (see attached picture). The error is taking place on this line:
Then
WBName = CreateWB(Environ("USERPROF
for this specific code reference point: CreateWB
Here is the entire code I now have put in:
Function CreateWB(NewWBPath As String, VerName As String, NewWBName As String, Nam As Name) As String
Dim WS As Worksheet
Dim WSS As Worksheet
Dim NewWb As Workbook
Dim FileSaved As Boolean
Application.DisplayAlerts = False
Application.ScreenUpdating
Set WS = ActiveSheet
Set NewWb = Workbooks.Add
FileSaved = False
Do
On Error Resume Next
NewWb.SaveAs Filename:=NewWBPath & VerName & "\" & Nam.NameLocal, FileFormat:=xlExcel8
Select Case Err
Case 1004
MkDir NewWBPath
MkDir NewWBPath & VerName
On Error GoTo 0
Case 0
FileSaved = True
End Select
Loop Until FileSaved
Nam.RefersToRange.Copy NewWb.Worksheets(1).Range(
NewWb.Worksheets(1).UsedRa
ActiveSheet.Name = NewWBName
For Each WSS In NewWb.Worksheets
If InStr(1, WSS.Name, "Sheet") <> 0 Then WSS.Delete
Next WSS
NewWb.Save
CreateWB = NewWb.FullName
NewWb.Close
Set NewWb = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating
End Function
Sub GetCategories()
Dim I As Long
Dim WS As Worksheet
Dim MaxRow As Long
Dim WBName As String
Dim WBCount As Long
Dim Nam As Name
Dim VerFolder As String
If MsgBox("Are you ready to Create Workbook " & ActiveSheet.Range("C19") & " ?", vbQuestion + vbYesNo, "Send Emails") = vbYes Then
Set WS = ActiveSheet
VerFolder = Format(Now, "yyyymmdd hhmm") & " - " & ActiveSheet.Range("C20")
For Each Nam In Application.Names
If LCase(Left(Nam.Name, 8)) = "category" And LCase(Right(Nam.Name, 6)) = "survey" Then
WBName = CreateWB(Environ("USERPROF
WBCount = WBCount + 1
End If
Next Nam
MsgBox ("A total of " & WBCount & " Workbooks has been saved under worksheet name: " & ActiveSheet.Range("C19") & " successfully on the Desktop under folder " & ActiveSheet.Range("C20"))
End If
End Sub
Any ideas?
b.
Error-in-code.png
Active 1 day ago
Yes for sure there is an error as you combined 2 cells in one !!! what is the valjjue of B2 ?
gowflow
gowflow
Active 2 days ago
The value of B2 is a Text field such as C20 or C19.
B2 = ABC Company
I can add another field if that would work (such as B3) and substitute it for C19 in the code.
B.
B2 = ABC Company
I can add another field if that would work (such as B3) and substitute it for C19 in the code.
B.
Active 1 day ago
nope I tried it with B2 = John's Worksheet and it worked perfectly.
You pated my code not the code you put in your workbook. Can you paste here the CreateWB Sub as it is in your workbook ?
Anyway I attached the code that works refering to B2. Simply copy it and paste it in a module.
You pated my code not the code you put in your workbook. Can you paste here the CreateWB Sub as it is in your workbook ?
Anyway I attached the code that works refering to B2. Simply copy it and paste it in a module.
Function CreateWB(NewWBPath As String, VerName As String, NewWBName As String, Nam As Name) As String
Dim WS As Worksheet
Dim WSS As Worksheet
Dim NewWb As Workbook
Dim FileSaved As Boolean
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set WS = ActiveSheet
Set NewWb = Workbooks.Add
FileSaved = False
Do
On Error Resume Next
NewWb.SaveAs Filename:=NewWBPath & VerName & "\" & Nam.NameLocal, FileFormat:=xlExcel8
Select Case Err
Case 1004
MkDir NewWBPath
MkDir NewWBPath & VerName
On Error GoTo 0
Case 0
FileSaved = True
End Select
Loop Until FileSaved
Nam.RefersToRange.Copy NewWb.Worksheets(1).Range("A1")
NewWb.Worksheets(1).UsedRange.Columns.AutoFit
ActiveSheet.Name = NewWBName
For Each WSS In NewWb.Worksheets
If InStr(1, WSS.Name, "Sheet") <> 0 Then WSS.Delete
Next WSS
NewWb.Save
CreateWB = NewWb.FullName
NewWb.Close
Set NewWb = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Function
Sub GetCategories()
Dim I As Long
Dim WS As Worksheet
Dim MaxRow As Long
Dim WBName As String
Dim WBCount As Long
Dim Nam As Name
Dim VerFolder As String
If MsgBox("Are you ready to Create Workbook " & ActiveSheet.Range("B2") & " ?", vbQuestion + vbYesNo, "Send Emails") = vbYes Then
Set WS = ActiveSheet
VerFolder = Format(Now, "yyyymmdd hhmm") & " - " & ActiveSheet.Range("B2")
For Each Nam In Application.Names
If LCase(Left(Nam.Name, 8)) = "category" And LCase(Right(Nam.Name, 6)) = "survey" Then
WBName = CreateWB(Environ("USERPROFILE") & "\Desktop\" & ActiveSheet.Range("B2") & "\", VerFolder, ActiveSheet.Range("B2"), Nam)
WBCount = WBCount + 1
End If
Next Nam
MsgBox ("A total of " & WBCount & " Workbooks has been saved under worksheet name: " & ActiveSheet.Range("B2") & " successfully on the Desktop under folder " & ActiveSheet.Range("B2"))
End If
End Sub
Active 1 day ago
glad u did coz u scared me for a while, I bet it was a mistyping somewhere. anyhow you did not answer my comment prior to your problem read the comment above and let me know.
gowflow
gowflow
Active 2 days ago
gowflow,
Here is the actual code I am using. You will see the CreateWB line about half way down.
Question for you; How do I pass the paste parameters over to the output so that the format is the same as in the original sheet? Right now it pastes it but I have to reformat every file in order for it to look the same. Seems like that would be a minor adjustment or a single line passing the parameters of "type" of paste or copy that occurs.
All the best,
B.
'This module is for saving data to the desktop
Function CreateWB(NewWBPath As String, VerName As String, NewWBName As String, Nam As Name) As String
Dim WS As Worksheet
Dim WSS As Worksheet
Dim NewWb As Workbook
Dim FileSaved As Boolean
Application.DisplayAlerts = False
Application.ScreenUpdating
Set WS = ActiveSheet
Set NewWb = Workbooks.Add
FileSaved = False
Do
On Error Resume Next
NewWb.SaveAs Filename:=NewWBPath & VerName & "\" & Nam.NameLocal, FileFormat:=xlExcel8
Select Case Err
Case 1004
MkDir NewWBPath
MkDir NewWBPath & VerName
On Error GoTo 0
Case 0
FileSaved = True
End Select
Loop Until FileSaved
Nam.RefersToRange.Copy NewWb.Worksheets(1).Range(
NewWb.Worksheets(1).UsedRa
ActiveSheet.Name = NewWBName
For Each WSS In NewWb.Worksheets
If InStr(1, WSS.Name, "Sheet") <> 0 Then WSS.Delete
Next WSS
NewWb.Save
CreateWB = NewWb.FullName
NewWb.Close
Set NewWb = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating
End Function
Sub GetCategories()
Dim I As Long
Dim WS As Worksheet
Dim MaxRow As Long
Dim WBName As String
Dim WBCount As Long
Dim Nam As Name
Dim VerFolder As String
If MsgBox("Are you ready to Create Workbook " & ActiveSheet.Range("B2") & " ?", vbQuestion + vbYesNo, "Send Emails") = vbYes Then
Set WS = ActiveSheet
VerFolder = Format(Now, "yyyymmdd hhmm") & " - " & ActiveSheet.Range("B2")
For Each Nam In Application.Names
If LCase(Left(Nam.Name, 8)) = "category" And LCase(Right(Nam.Name, 6)) = "survey" Then
WBName = CreateWB(Environ("USERPROF
WBCount = WBCount + 1
End If
Next Nam
MsgBox ("A total of " & WBCount & " Workbooks has been saved under worksheet name: " & ActiveSheet.Range("B2") & " successfully on the Desktop under folder " & ActiveSheet.Range("B2"))
End If
End Sub
Here is the actual code I am using. You will see the CreateWB line about half way down.
Question for you; How do I pass the paste parameters over to the output so that the format is the same as in the original sheet? Right now it pastes it but I have to reformat every file in order for it to look the same. Seems like that would be a minor adjustment or a single line passing the parameters of "type" of paste or copy that occurs.
All the best,
B.
'This module is for saving data to the desktop
Function CreateWB(NewWBPath As String, VerName As String, NewWBName As String, Nam As Name) As String
Dim WS As Worksheet
Dim WSS As Worksheet
Dim NewWb As Workbook
Dim FileSaved As Boolean
Application.DisplayAlerts = False
Application.ScreenUpdating
Set WS = ActiveSheet
Set NewWb = Workbooks.Add
FileSaved = False
Do
On Error Resume Next
NewWb.SaveAs Filename:=NewWBPath & VerName & "\" & Nam.NameLocal, FileFormat:=xlExcel8
Select Case Err
Case 1004
MkDir NewWBPath
MkDir NewWBPath & VerName
On Error GoTo 0
Case 0
FileSaved = True
End Select
Loop Until FileSaved
Nam.RefersToRange.Copy NewWb.Worksheets(1).Range(
NewWb.Worksheets(1).UsedRa
ActiveSheet.Name = NewWBName
For Each WSS In NewWb.Worksheets
If InStr(1, WSS.Name, "Sheet") <> 0 Then WSS.Delete
Next WSS
NewWb.Save
CreateWB = NewWb.FullName
NewWb.Close
Set NewWb = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating
End Function
Sub GetCategories()
Dim I As Long
Dim WS As Worksheet
Dim MaxRow As Long
Dim WBName As String
Dim WBCount As Long
Dim Nam As Name
Dim VerFolder As String
If MsgBox("Are you ready to Create Workbook " & ActiveSheet.Range("B2") & " ?", vbQuestion + vbYesNo, "Send Emails") = vbYes Then
Set WS = ActiveSheet
VerFolder = Format(Now, "yyyymmdd hhmm") & " - " & ActiveSheet.Range("B2")
For Each Nam In Application.Names
If LCase(Left(Nam.Name, 8)) = "category" And LCase(Right(Nam.Name, 6)) = "survey" Then
WBName = CreateWB(Environ("USERPROF
WBCount = WBCount + 1
End If
Next Nam
MsgBox ("A total of " & WBCount & " Workbooks has been saved under worksheet name: " & ActiveSheet.Range("B2") & " successfully on the Desktop under folder " & ActiveSheet.Range("B2"))
End If
End Sub
Active 1 day ago
I had the Columns Autofit. Try this version is it better ?
Paste the whole code in the Module instead of the previous one.
Let me know.
gowflow
Saving-Category-VersionControl.xlsm
Paste the whole code in the Module instead of the previous one.
Function CreateWB(NewWBPath As String, VerName As String, NewWBName As String, Nam As Name) As String
Dim WS As Worksheet
Dim WSS As Worksheet
Dim NewWb As Workbook
Dim FileSaved As Boolean
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set WS = ActiveSheet
Set NewWb = Workbooks.Add
FileSaved = False
Do
On Error Resume Next
NewWb.SaveAs Filename:=NewWBPath & VerName & "\" & Nam.NameLocal, FileFormat:=xlExcel8
Select Case Err
Case 1004
MkDir NewWBPath
MkDir NewWBPath & VerName
On Error GoTo 0
Case 0
FileSaved = True
End Select
Loop Until FileSaved
Nam.RefersToRange.Copy
NewWb.Worksheets(1).Range("A1").PasteSpecial Paste:=xlPasteFormats
NewWb.Worksheets(1).Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
NewWb.Worksheets(1).Range("A1").PasteSpecial Paste:=xlPasteAll
'NewWb.Worksheets(1).UsedRange.Columns.AutoFit
ActiveSheet.Name = NewWBName
For Each WSS In NewWb.Worksheets
If InStr(1, WSS.Name, "Sheet") <> 0 Then WSS.Delete
Next WSS
NewWb.Save
CreateWB = NewWb.FullName
NewWb.Close
Set NewWb = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Function
Sub GetCategories()
Dim I As Long
Dim WS As Worksheet
Dim MaxRow As Long
Dim WBName As String
Dim WBCount As Long
Dim Nam As Name
Dim VerFolder As String
If MsgBox("Are you ready to Create Workbook " & ActiveSheet.Range("B2") & " ?", vbQuestion + vbYesNo, "Send Emails") = vbYes Then
Set WS = ActiveSheet
VerFolder = Format(Now, "yyyymmdd hhmm") & " - " & ActiveSheet.Range("B2")
For Each Nam In Application.Names
If LCase(Left(Nam.Name, 8)) = "category" And LCase(Right(Nam.Name, 6)) = "survey" Then
WBName = CreateWB(Environ("USERPROFILE") & "\Desktop\" & ActiveSheet.Range("B2") & "\", VerFolder, ActiveSheet.Range("B2"), Nam)
WBCount = WBCount + 1
End If
Next Nam
MsgBox ("A total of " & WBCount & " Workbooks has been saved under worksheet name: " & ActiveSheet.Range("B2") & " successfully on the Desktop under folder " & ActiveSheet.Range("B2"))
End If
End Sub
Let me know.
gowflow
Saving-Category-VersionControl.xlsm
Active 2 days ago
Gowflow,
Very sorry for the delay. I came down with the flu yesterday and was out all day. I'm just getting to it this morning and will follow up in an hour or so. If you haven't had this strain of Flu, believe me, you don't want it.
B.
Very sorry for the delay. I came down with the flu yesterday and was out all day. I'm just getting to it this morning and will follow up in an hour or so. If you haven't had this strain of Flu, believe me, you don't want it.
B.
Active 1 day ago
Well I had worst than Flu !!!! had herpies close to my eye and it killed like hell .... but still I could manage to get your file done !!! :) (no sarcastic, just real fact) take care and take ur time no sweat.
gowflow
gowflow
Active 2 days ago
Wow....that's really bad. I guess I should count my blessings.
So although feeling like I'm on a death bed, and not to be outdone by your commitment to helping me out here, I've been testing it and here is the problem.
Your change to "format" works but I have discovered another problem (hopefully easy to resolve). The Worksheet with the range name that your macro picks up and copies/pastes refers to another Worksheet because in the WS that is copied, I have formulas embedded. In otherwords, I have statements that are within the range name that instead of being strictly "text", they are pulled from another WS (e.g. =(Master_Statement!B4), and so on. Is there a way to have the macro copy and paste without carrying over the formulas? I think again, it may be a "paste option". Otherwise, what it is doing is pasting and duplicating the other reference Worksheet.
Any ideas?
B.
So although feeling like I'm on a death bed, and not to be outdone by your commitment to helping me out here, I've been testing it and here is the problem.
Your change to "format" works but I have discovered another problem (hopefully easy to resolve). The Worksheet with the range name that your macro picks up and copies/pastes refers to another Worksheet because in the WS that is copied, I have formulas embedded. In otherwords, I have statements that are within the range name that instead of being strictly "text", they are pulled from another WS (e.g. =(Master_Statement!B4), and so on. Is there a way to have the macro copy and paste without carrying over the formulas? I think again, it may be a "paste option". Otherwise, what it is doing is pasting and duplicating the other reference Worksheet.
Any ideas?
B.
Active 1 day ago
yes no problem
here it is
In the Sub CreateWB replace this line
NewWb.Worksheets(1).Range(
by this line
NewWb.Worksheets(1).Range(
Save and exit run again and let me know.
gowflow
here it is
In the Sub CreateWB replace this line
NewWb.Worksheets(1).Range(
by this line
NewWb.Worksheets(1).Range(
Save and exit run again and let me know.
gowflow
Active 2 days ago
Perfect! Works very well........... Thank you again for sticking with me....... if you were in my neighborhood, I'd be taking you to dinner (as soon as I'm well again!).
All the best and will keep you informed.
B.
All the best and will keep you informed.
B.
Active 1 day ago
Tks and glad it worked well for you. Take care and hv a good rest. for sure u can't take me to dinner, ... :) but instead you can let me know if you need further help on other issues.
Rgds/gowflow
Rgds/gowflow
Active 2 days ago
Greetings gowflow. News? The code you sent me works great; I've incorporated it into my master WB and I appreciate the help. Beyond that, I'm about 80% recovered from the flu....it's really bad around the US right now.
If you want to keep in touch maybe we should exchange email addresses?
B.
If you want to keep in touch maybe we should exchange email addresses?
B.
Active 1 day ago
No problem but rules here on EE is not to exchange email addresses as it is unethical. I will keep this question monitored if and when in the future you need help pls post a link here and I will be glad to assist you. Tks for your greetings and glad you are better now. Take care.
gowflow
gowflow
Featured Post
Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.
One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.
Question has a verified solution.
If you are experiencing a similar issue, please ask a related question
Introduction
This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results.
Paraphrasing Richard Shockley, author of my favourite finance reference tex…
After seeing numerous questions for Dynamic Data Validation I notice that most have used Visual Basic to solve the problem. This suggestion is purely formula based and can be used in multiple rows.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
Suggested Courses
Earn Certification
HTML5 Specialist - Certification
Free withPremium
Course of the Month11 days, 3 hours left to enroll
631 members asked questions and received personalized solutions in the past 7 days.
Join the community of 500,000 technology professionals and ask your questions.