Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.
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 today
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 today
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.
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 today
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
Yes for sure there is an error as you combined 2 cells in one !!! what is the valjjue of B2 ?
gowflow
gowflow
Active today
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.
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
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 today
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
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 today
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.
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 today
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.
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 today
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.
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 today
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.
Featured Post
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!
Question has a verified solution.
If you are experiencing a similar issue, please ask a related question
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…
Suggested Courses
Course of the Month6 days, 8 hours left to enroll
705 members asked questions and received personalized solutions in the past 7 days.
Join the community of 500,000 technology professionals and ask your questions.