PDA

View Full Version : Solved: Macro to creat a values only version of Activeworkbook



xluser2007
03-05-2008, 06:18 PM
Hi All,

I am trying to write a mcaro to create a vlaues only version of my active workbook. So in words the steps are (assuming the desired workbook is already open and active):
Create a copy of the Active workbook - call it say newvaluesworkbook in VBA.
In newvaluesworkbook. select all worksheets and globally value paste over their existing cells - thus making it values only.
All cells in newvaluesworkbook should have no highlighting i.e. Colorindex = Xlnone.
Set all tab colours in newvaluesworkbook to have "No Colour"
Delete all comments in newvaluesworkbook.
Save newvaluesworkbook with the same name as the Active workbook but append with "_values only". E.g. if active workbook is SpreadsheetD.xls, then newvaluesworkbook should be named as SpreadsheetD_values only.xls
Save the newvaluesworkbook workbook in the same directory as the activeworkbook, but in the Values folder. E.g If we have C:\SpreadsheetD.xls, then we want to create C:\Values\SpreadsheetD.xls. The values folder will exist for the active workbooks selected.I tried to start Steps 3, 4 and 5, but even they seem to fall apart at each for loops with "Runtime erros 13 - debug mismatch". The program I wriote is as follows:

Sub create_Values_only_workbook()

Dim wbkwkshts As Worksheets
Dim wbkcomment As Comments

Application.ScreenUpdating = False

For Each wbkcomment In ThisWorkbook.Worksheets
wbkcomment.Delete
Next

For Each wbkwkshts In ThisWorkbook.Worksheets
wbkwkshts.Cells.Select
Selection.Interior.ColorIndex = xlNone
wbkwkshts.Tab.ColorIndex = -4142
Next

Application.ScreenUpdating = True

End Sub
If anyone could please anyone please guide me in writing the above, I would really appreciate it.

lucas
03-05-2008, 06:56 PM
Hi
Try this to save a copy of your file, leave it open and remove the formula's.....just to get you started...

saves a copy to C:\Temp you can change that in the code. I attached a simple example for you. The highlighted cell in each sheet has a simple formula in it. look at the formula's then run the code....look at the forumula cells again.


Option Explicit
Sub SaveAsExample()
Dim FName As String
Dim FPath As String
Dim ws As Worksheet

FPath = "f:\Temp"
FName = "newvaluesworkbook"
ThisWorkbook.SaveAs Filename:=FPath & "\" & FName

For Each ws In ActiveWorkbook.Worksheets
With Cells
.Select
.Copy
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End With
Next ws
Sheets("Sheet1").Select
Range("A1").Select
Set ws = Nothing
End Sub


As I said, this will make a copy of the workbook and remove all formula's from all sheets. You should be able to go from there but if you have trouble post back here for help....

xluser2007
03-05-2008, 08:36 PM
Thanks lucas, that was great help, didin't know the "path" command before.

Here are the amendments I have made so far:

Option Explicit
Sub SaveAsExample()

Dim SourcewbkFilePath As String
Dim TargetFilePath As String
Dim TargetFileName As String
Dim Full_TargetFilePath_and_Name As String
Dim ws As Worksheet
Dim Sourcewbk As Workbook
Dim Sourcewbkname As String

Set Sourcewbk = ThisWorkbook

SourcewbkFilePath = Sourcewbk.Path
Debug.Print SourcewbkFilePath

TargetFilePath = SourcewbkFilePath & "\Values"
Debug.Print TargetFilePath

Sourcewbkname = Sourcewbk.Name
Debug.Print Sourcewbkname

TargetFileName = Sourcewbkname & "_values only"
Debug.Print TargetFileName

Full_TargetFilePath_and_Name = TargetFilePath & "\" & TargetFileName
Debug.Print Full_TargetFilePath_and_Name

Sourcewbk.SaveAs Filename:=Full_TargetFilePath_and_Name

For Each ws In ActiveWorkbook.Worksheets
With Cells
.Select
.Copy
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End With
Next ws

Sheets("Sheet1").Select
Range("A1").Select
Set ws = Nothing

End Sub
Up to the For Each ws In ActiveWorkbook.Worksheets line it is now creating the correct names for the filepaths and directories.

Now, to my understanding this would save the Sourcewbk i.e.e the orginal workbook into the new "Full_TargetFilePath_and_Name" location.

How do I set the name for the name the Target Values only version in VBA e.g. Set targetValueswbk = ...? (I'm not sure how to incorporate it into the SaveAs Command).

this way it's easier to refer to than Activeworkbook, which is not a very specific reference.

Also how do I incorporate my previous code of deleting all coments in teh values only workbook and decolouring all cells and tab colours into this revised code? The code was failing at the loops (not sure why) and also unsure of how to integrate it into the above code.

Any help with this would be greatly appreciated

reagrds,

lucas
03-05-2008, 09:43 PM
Charlie, I really don't understand the first question. Can you try to clarify this part for us? I see no problem with activeworkbook if it's going to be run from that workbook....although you use thisworkbook......just as good I think........I'm a little confused.

How do I set the name for the name the Target Values only version in VBA e.g. Set targetValueswbk = ...? (I'm not sure how to incorporate it into the SaveAs Command).

this way it's easier to refer to than Activeworkbook, which is not a very specific reference.

You do need to change this part though so it will add the .xls to the filename.

change
Sourcewbk.SaveAs Filename:=Full_TargetFilePath_and_Name
to

Sourcewbk.SaveAs Filename:=Full_TargetFilePath_and_Name & ".xls"

xluser2007
03-05-2008, 10:17 PM
Hi lucas,

Sorry if I was confusing earlier. I just meant that the new values only workbook should be given a new object name in VBA e.g.

Set target_valuesonly_wbk = Sourcewbk.SaveAs Filename:=Full_TargetFilePath_and_Name & ".xls"or something similar, though this syntax doesn;t do what i would like it to.

This way it is easier and more specific way to refer to it as "target_valuesonly_wbk" for the remaining code. Is there a way to do this?

The second question was on how to integrate my earlier (incorrect code) into your suggested one above i.e. the code below:

Sub create_Values_only_workbook()

Dim wbkwkshts As Worksheets
Dim wbkcomment As Comments

Application.ScreenUpdating = False

For Each wbkcomment In ThisWorkbook.Worksheets
wbkcomment.Delete
Next

For Each wbkwkshts In ThisWorkbook.Worksheets
wbkwkshts.Cells.Select
Selection.Interior.ColorIndex = xlNone
wbkwkshts.Tab.ColorIndex = -4142
Next

Application.ScreenUpdating = True

End Sub
Thank you for your help and patience, newbies like me appreciate this. :hi:

regards

xluser2007
03-06-2008, 01:15 AM
I played around more and here is the resulting VBA code:

Option Explicit
Sub SaveAsExample()
Dim sh As Worksheet
Dim cmt As Comment
Dim SourcewbkFilePath As String
Dim TargetFilePath As String
Dim TargetFileName As String
Dim Full_TargetFilePath_and_Name As String
Dim ws As Worksheet
Dim Sourcewbk As Workbook
Dim Sourcewbkname As String
Dim shortsourcewbkname As String

Application.DisplayAlerts = False

Set Sourcewbk = ThisWorkbook

SourcewbkFilePath = Sourcewbk.Path
Debug.Print SourcewbkFilePath

TargetFilePath = SourcewbkFilePath & "\Values"
Debug.Print TargetFilePath

Sourcewbkname = Sourcewbk.Name
Debug.Print Sourcewbkname

shortsourcewbkname = Left(Sourcewbkname, Len(Sourcewbkname) - 4)
Debug.Print shortsourcewbkname

TargetFileName = shortsourcewbkname & "_values only" & ".xls"
Debug.Print TargetFileName

Full_TargetFilePath_and_Name = TargetFilePath & "\" & TargetFileName
Debug.Print Full_TargetFilePath_and_Name

Sourcewbk.SaveAs Filename:=Full_TargetFilePath_and_Name

For Each ws In ActiveWorkbook.Worksheets
With Cells
.Select
.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End With
Next ws

For Each ws In ActiveWorkbook.Worksheets
For Each cmt In ws.Comments
cmt.Delete
Next
Next ws

For Each ws In ActiveWorkbook.Worksheets
With Cells
.Select
Selection.Interior.ColorIndex = xlNone
End With
Next ws

For Each ws In ActiveWorkbook.Worksheets
ws.Tab.ColorIndex = -4142
Next ws

Application.DisplayAlerts = True

' ActiveWorkbook.Close SaveChanges:=True

End Sub

This code though, doesn;t paste over the original sheet links and formulas as values only (as it should):

For Each ws In ActiveWorkbook.Worksheets
With Cells
.Select
.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End With
Next ws
I can't understand why. Could anyone please explain how to correct. I would be really appreciate it.

Bob Phillips
03-06-2008, 03:04 AM
Sub SaveAsExample()
Dim cmt As Comment
Dim SourcewbkFilePath As String
Dim TargetFilePath As String
Dim TargetFileName As String
Dim Full_TargetFilePath_and_Name As String
Dim ws As Worksheet
Dim Sourcewbk As Workbook
Dim Sourcewbkname As String
Dim shortsourcewbkname As String

Application.DisplayAlerts = False

Set Sourcewbk = ThisWorkbook

SourcewbkFilePath = Sourcewbk.Path
TargetFilePath = SourcewbkFilePath & "\Values"
Sourcewbkname = Sourcewbk.Name
shortsourcewbkname = Left(Sourcewbkname, Len(Sourcewbkname) - 4)
TargetFileName = shortsourcewbkname & "_values only" & ".xls"
Full_TargetFilePath_and_Name = TargetFilePath & "\" & TargetFileName
Sourcewbk.SaveAs Filename:=Full_TargetFilePath_and_Name

For Each ws In ActiveWorkbook.Worksheets

With ws.Cells

.Value = .Value
.Interior.ColorIndex = xlColorIndexNone
End With

For Each cmt In ws.Comments
cmt.Delete
Next

ws.Tab.ColorIndex = xlColorIndexNone
Next ws

Application.DisplayAlerts = True

' ActiveWorkbook.Close SaveChanges:=True

End Sub

xluser2007
03-06-2008, 04:00 AM
xld,

Thank you for that elegant amendment to the code, works correctly now.

However the value 'pasting' part of the code seems to take a really long time as it goes cell by cell, worksheet by worksheet.

Normally the method I use is Shift tab and select all worksheets, Ctrl +A, Ctrl+C and then Paste Special values, and it works really quickly.

I opened up a new workbook "Book1" and recorded this process as follows:

Sub Macro1()
Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
Sheets("Sheet1").Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
How could this be added to the existing code, not sure how to generalise the Sheets(Array([...])).select command when there are numerous worksheets with different names.

Also another conceptual question, with this method the original workbook seems to disappear from view. Is this becasue we are saving it in a different location and no longer using the original? I normally physically copy the original Excel file in Explorer to the Values folder and then manually do the above process, so I know for sure that the original is not aletred in any way.

I have tested the above code and the original is unaltered and the values- only version is altered and saved in its own folder. I know I;m just being just being paranoid :), and thus want to ask whether there is a way we can ensure that the original will never be altered with this code?

Again thankyou very much for your help thus far, if you could help me on the above additional queries, that would be awesome!

Bob Phillips
03-06-2008, 05:01 AM
See if this quicker



Sub SaveAsExample()
Dim cmt As Comment
Dim SourcewbkFilePath As String
Dim TargetFilePath As String
Dim TargetFileName As String
Dim Full_TargetFilePath_and_Name As String
Dim ws As Worksheet
Dim Sourcewbk As Workbook
Dim Sourcewbkname As String
Dim shortsourcewbkname As String

With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With

Set Sourcewbk = ThisWorkbook

SourcewbkFilePath = Sourcewbk.Path
TargetFilePath = SourcewbkFilePath & "\Values"
Sourcewbkname = Sourcewbk.Name
shortsourcewbkname = Left(Sourcewbkname, Len(Sourcewbkname) - 4)
TargetFileName = shortsourcewbkname & "_values only" & ".xls"
Full_TargetFilePath_and_Name = TargetFilePath & "\" & TargetFileName
Sourcewbk.SaveAs Filename:=Full_TargetFilePath_and_Name

For Each ws In ActiveWorkbook.Worksheets

With ws.UsedRange

.Value = .Value
.Interior.ColorIndex = xlColorIndexNone
End With

For Each cmt In ws.Comments
cmt.Delete
Next

ws.Tab.ColorIndex = xlColorIndexNone
Next ws

With Application
.DisplayAlerts = True
.ScreenUpdating = True
End If

' ActiveWorkbook.Close SaveChanges:=True

End Sub


Trust me!

xluser2007
03-06-2008, 04:07 PM
xld, that was superb!

Very fast indeed. So it was all just an issue with Screen Updating then and that used range command (never knew that one either)??

A very minor correction, the code ended with an "End If" instead of "End With", as modified below.

With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
Also I do trust your super skills mate, just my VBA that I don't quite as yet (:rotlaugh:)

Thanks again.

xluser2007
03-06-2008, 04:16 PM
Last question,

In teh Values only version that is created, is there a way to delete the macro in it, so the person receiving it can;t view the code.

Or is there a worksround for it.

That the code should remain in the original but not in the values only version.

Any way of doing this?

Bob Phillips
03-06-2008, 04:19 PM
I would guess the real value was obtained by using UseRange rather than Cells, it would cut down the number of cells being processed on each sheet by a huge amount. Screenupdating off would add little I feel, especially as I had already removed the selecting, but it is always useful though.

The root of your paranoia was not actually seeing it. This was because my first change removed all of the selecting and so on, which stops the screen repainting, removing the comfort factor. The price of efficiency and speed I am afraid, and ScreenUpdating off only makes it worse. But of course, the way to alleviate paranoia is to test it (see my comment below <g>).

Sorry about the End If, one day I will test my code <G>

Bob Phillips
03-06-2008, 04:25 PM
You could whack this in at the end of the code



Dim vbMod As Object

Set vbMod = ActiveWorkbook.VBProject.VBComponents("Module1")
ThisWorkbook.VBProject.VBComponents.Remove vbMod


but all of the code is gone forever then.

lucas
03-06-2008, 05:19 PM
This might be handy as part of an addin that you could run on the active workbook......you would want to leave out that last part that Bob gave you to remove the code module though.

xluser2007
03-06-2008, 05:53 PM
Hi lucas, xld,

When I tried to run the previous code of xld's to delete, I get the run time error in the line:

Set vbMod = ActiveWorkbook.VBProject.VBComponents("Module1")
The error is a run-time '1004' error with message

"Method of 'VBProject' of Object '_Workbook' failed"

Is there a way to correct this.

Lucas, with regards to your suggestion, this macro should be pasted in the original workbooks and only deleted from the valuesonly version. the users that the valuesonly versions are sent to shouldn;t have this macro to look at. That's why I want to delete it before saving the valuesonly version.

Is there a reason you feel this last bit of code is not good prcatice for this exercise?

regards,

xluser2007
03-06-2008, 10:18 PM
I just earched around a bit more and have now made the code as follows:

Sub Create_values_only()
Dim cmt As Comment
Dim SourcewbkFilePath As String
Dim TargetFilePath As String
Dim TargetFileName As String
Dim Full_TargetFilePath_and_Name As String
Dim ws As Worksheet
Dim Sourcewbk As Workbook
Dim Sourcewbkname As String
Dim shortsourcewbkname As String

With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With

Set Sourcewbk = ThisWorkbook

SourcewbkFilePath = Sourcewbk.Path
TargetFilePath = SourcewbkFilePath & "\Values"
Sourcewbkname = Sourcewbk.Name
shortsourcewbkname = Left(Sourcewbkname, Len(Sourcewbkname) - 4)
TargetFileName = shortsourcewbkname & "_values only" & ".xls"
Full_TargetFilePath_and_Name = TargetFilePath & "\" & TargetFileName
Sourcewbk.SaveAs Filename:=Full_TargetFilePath_and_Name

For Each ws In ActiveWorkbook.Worksheets

With ws.UsedRange

.Value = .Value
.Interior.ColorIndex = xlColorIndexNone
End With

For Each cmt In ws.Comments
cmt.Delete
Next

ws.Tab.ColorIndex = xlColorIndexNone
Next ws

With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With

Call DeleteVBComponent(ActiveWorkbook, "Module1")

End Sub

Sub DeleteVBComponent(ByVal wb As Workbook, ByVal CompName As String)
' deletes the vbcomponent named CompName from wb
Application.DisplayAlerts = False
On Error Resume Next ' ignores any errors
wb.VBProject.VBComponents.Remove wb.VBProject.VBComponents(CompName)
' delete the component
On Error GoTo 0
Application.DisplayAlerts = True
End Sub

Though as before the DeleteVBComponent, i.e.e deleting Module1 doesn't work in terms of deleting the module from the values only workbook.

Any thoughts on how to correct for the above (slightly modified code)?

Bob Phillips
03-07-2008, 02:44 AM
Is your module called Module1?

xluser2007
03-07-2008, 03:54 AM
Hi xld, yes its definetely Module1.

Have you by any chance tried the full code, did you have any success with it, or I it just some issue with mine you reckon?

xluser2007
03-07-2008, 03:58 PM
I tried to work with this further and went to Chip Pearsons useful website.

I found the following code to delete a module:

Sub DeleteModule()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent

Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents("Module1")
VBProj.VBComponents.Remove VBComp
End Sub


This didn;t like the VIIDE reference for VB Proj and stalled there.

I am at a loss to explain how to delete my original code :doh: from the values only version.

VBGuru's could you please shed some light on this.

lucas
03-07-2008, 05:41 PM
This works for me......the original retains the code and the new copy that stays open loses it........I just added Bob's code to the previous code that you were using....at the very end and added the dim statement to the beginning....

Option Explicit
Sub SaveAsExample()
Dim cmt As Comment
Dim SourcewbkFilePath As String
Dim TargetFilePath As String
Dim TargetFileName As String
Dim Full_TargetFilePath_and_Name As String
Dim ws As Worksheet
Dim Sourcewbk As Workbook
Dim Sourcewbkname As String
Dim shortsourcewbkname As String
Dim vbMod As Object
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With

Set Sourcewbk = ThisWorkbook

SourcewbkFilePath = Sourcewbk.Path
TargetFilePath = SourcewbkFilePath & "\Values"
Sourcewbkname = Sourcewbk.Name
shortsourcewbkname = Left(Sourcewbkname, Len(Sourcewbkname) - 4)
TargetFileName = shortsourcewbkname & "_values only" & ".xls"
Full_TargetFilePath_and_Name = TargetFilePath & "\" & TargetFileName
Sourcewbk.SaveAs Filename:=Full_TargetFilePath_and_Name

For Each ws In ActiveWorkbook.Worksheets

With ws.UsedRange

.Value = .Value
.Interior.ColorIndex = xlColorIndexNone
End With

For Each cmt In ws.Comments
cmt.Delete
Next

ws.Tab.ColorIndex = xlColorIndexNone
Next ws

With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With

' ActiveWorkbook.Close SaveChanges:=True


Set vbMod = ActiveWorkbook.VBProject.VBComponents("Module1")
ThisWorkbook.VBProject.VBComponents.Remove vbMod
End Sub

xluser2007
03-07-2008, 07:43 PM
lucas,

thanks for testing and sending your code through.

I tried again and it still fails, very strange. The error is however a runtime 1004 "Programattic Access to Visual Basic project is not trusted".

IS this an Excel specific issue to my comupeter or Excel installation :dunno?

I really appreciate both yours and xld's help. I know I keep on bugging you both with this error, but I'd like to get to the bottom of it and understand why its affecting me and not others.

Any guidance on this is appreciated.

xluser2007
03-07-2008, 07:48 PM
Ahh googled it and the answer is in your Excel, do the following from the following link http://support.microsoft.com/kb/q282830/:

Office 2003 and Office XP

loadTOCNode(2, 'resolution');1.Open the Office 2003 or Office XP application in question. On the Tools menu, click Macro, and then click Security to open the Macro Security dialog box.2.On the Trusted Sources tab, click to select the Trust access to Visual Basic Project check box to turn on access.3.Click OK to apply the setting. You may need to restart the application for the code to run properly if you automate from a Component Object Model (COM) add-in or template.
Now the code works. Thanks for your help again xld and lucas.

regards

lucas
03-08-2008, 09:06 AM
The only thing causing you this problem is the code to remove the code module. If you put this in an addin you can run it on any excel worksheet and you will not have to worry about removing the code because it won't be necessary. Check our Articles. I think Johnkse has examples there for you to examine.

xluser2007
03-08-2008, 07:37 PM
Hi lucas,

Thanks for your reply. I did have aread of Johnske's helpful articles for Addin's and also found some tips on Ozgrid.com.

As a result I did the following:

Step 1. Opened a new Exce i.e. "Book1". Opened the VBE and put the following code in "Module1":

Sub Create_values_only()
Dim cmt As Comment
Dim SourcewbkFilePath As String
Dim TargetFilePath As String
Dim TargetFileName As String
Dim Full_TargetFilePath_and_Name As String
Dim ws As Worksheet
Dim Sourcewbk As Workbook
Dim Sourcewbkname As String
Dim shortsourcewbkname As String
Dim response As VbMsgBoxResult

With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With

Set Sourcewbk = ActiveWorkbook

SourcewbkFilePath = Sourcewbk.Path
Debug.Print SourcewbkFilePath

TargetFilePath = SourcewbkFilePath & "\Values"
Debug.Print TargetFilePath

Sourcewbkname = Sourcewbk.Name
Debug.Print Sourcewbkname

shortsourcewbkname = Left(Sourcewbkname, Len(Sourcewbkname) - 4)
Debug.Print shortsourcewbkname

TargetFileName = shortsourcewbkname & "_values only" & ".xls"
Debug.Print TargetFileName

Full_TargetFilePath_and_Name = TargetFilePath & "\" & TargetFileName
Debug.Print Full_TargetFilePath_and_Name

If Not DirExists(TargetFilePath) Then
response = MsgBox("Would you like to create a new values-only FOLDER: " _
& vbCrLf & TargetFilePath & vbCrLf & "and" & vbCrLf & _
"The corresponding values-only FILE:" & vbCrLf & TargetFileName & _
vbCrLf & "in this folder", vbYesNo, "Create VALUES-ONLY folder/file")
If response = vbYes Then
MkDir (TargetFilePath)
ChDir (TargetFilePath)
End If

If response = vbNo Then GoTo end_program_handler_without_creating_values_only_file
End If

Sourcewbk.SaveAs Filename:=Full_TargetFilePath_and_Name

For Each ws In ActiveWorkbook.Worksheets

With ws.UsedRange

.Value = .Value
.Interior.ColorIndex = xlColorIndexNone
End With

For Each cmt In ws.Comments
cmt.Delete
Next

ws.Tab.ColorIndex = xlColorIndexNone
Next ws

With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With

' Call DeleteVBComponent(ActiveWorkbook, "Module1")

ActiveWorkbook.Close SaveChanges:=True

GoTo End_with_successful_values_only_version_created

end_program_handler_without_creating_values_only_file:
MsgBox ("The Values only folder " & TargetFilePath & vbCrLf _
& "The corresponding values only file " & TargetFileName & " weren't created")

End_with_successful_values_only_version_created:

End Sub

'Sub DeleteVBComponent(ByVal wb As Workbook, ByVal CompName As String)
'' deletes the vbcomponent named CompName from wb
' Application.DisplayAlerts = False
' On Error Resume Next ' ignores any errors
' wb.VBProject.VBComponents.Remove wb.VBProject.VBComponents(CompName)
' ' delete the component
' On Error GoTo 0
' Application.DisplayAlerts = True
'End Sub

Function DirExists(strDir) As Boolean
'John Walkenbach interesting method
Dim x As String
On Error Resume Next
x = GetAttr(strDir) And 0
If Err = 0 Then DirExists = True Else DirExists = False
End Function


(Note: the delete module part is commented out for the purposes of creating the Add-in as per your recommendation).

Step 2. From OZgrid.com, I found the following code, and put it in "Thisworkbook" of my current work book.Option Explicit
Dim cControl As CommandBarButton

Private Sub Workbook_AddinInstall()

On Error Resume Next 'Just in case
'Delete any existing menu item that may have been left.
Application.CommandBars("Worksheet Menu Bar").Controls("Super Code").Delete
'Add the new menu item and Set a CommandBarButton Variable to it
Set cControl = Application.CommandBars("Worksheet Menu Bar").Controls.Add
'Work with the Variable
With cControl
.Caption = "Super Code"
.Style = msoButtonCaption
.OnAction = "MyGreatMacro"
'Macro stored in a Standard Module
End With

On Error GoTo 0

End Sub

Private Sub Workbook_AddinUninstall()

On Error Resume Next 'In case it has already gone.
Application.CommandBars("Worksheet Menu Bar").Controls("Super Code").Delete
On Error GoTo 0
End Sub
Step 3: Saved and Closed it as an .xla file called "Values_Only_Addin")

Step 4. Then opened and installed from tools>Add-Ins.

The Menu bar heading "Super Code" came up but when i clicked the button to run-it on the activeworkbook, it came up with a MsgBox:

"The macro 'Values_Only_Addin.xla!MyGreatMacro' cannot be found.

Could you please help me create this Addin. I have given it a try, but am new to this and would really appreciate it. Also how do I create a Command bar button (simley face like :)), as opposed to a whole new menu bar item?

Bob Phillips
03-09-2008, 02:15 AM
You have to have a macro called MyGreatMacro in the addin.

It sounds as though you should have assigned the macro Create_values_only to the OnACtion property of the toolbar button

xluser2007
03-09-2008, 02:40 AM
xld, thanks for pointing out my macro naming issue.


It sounds as though you should have assigned the macro Create_values_only to the OnACtion property of the toolbar button
I'm not quite sure how you mean to do this. I'm a novice in the Addin creation, so I directly used code on the net and tried experimenting. Could you please explain how to create this as a button.

Also In the revised code (i.e. the Create_values_only macro) that I had put in my most recent post, do you agree with the Msgbox code which allows you to make the "Values" folder in the Activeworkbook path if it doesn't already exist. Although I haven't directly encountered an error as yet, this is my first use of mkDir and ChDir functions. Your guru guidance on suggesting improvements to the code will be appreciated :).

Bob Phillips
03-09-2008, 02:55 AM
The code for creating the button is this



With cControl
.Caption = "Super Code"
.Style = msoButtonCaption
.OnAction = "MyGreatMacro"
'Macro stored in a Standard Module
End With


You will notice that the OnAction refers to "MyGreatMacro". You do not have such a macro, yours is called "Create_values_only", so that is the value you should be using.

If you want to give them the choice to create the directory, MsgBox is the best way to go. I notice that you use



MkDir (TargetFilePath)


It is probably not a problem here, but adding the brackets without using Call is not a good habit to get into. VBA evalautes the contents of the brackets in these circumstances and acts upon that, it can cause problems sometimes. Use



MkDir TargetFilePath

'or

Call MkDir(TargetFilePath)

xluser2007
03-10-2008, 03:43 PM
Hi xld, thanks for your informative reply.

I didn't know about the using Call when calling an application with brackets syntax before. Thanks for letting me know for future use.

With regards to your suggestions for the macro button, I am still trying it out (with mixed success). Will keep you posted on developments. And very soon, when tested, will mark this thread solved :)!

regards

lucas
03-10-2008, 04:00 PM
Many consider this cheating a little but this is what I use to create my menu's for addins:

http://j-walk.com/ss/excel/tips/tip53.htm

Bob Phillips
03-10-2008, 04:15 PM
Cheating? In what way? I don't use that, but I do use my own table driven menu builder in my production apps.

lucas
03-10-2008, 04:29 PM
Cheating? In what way? I don't use that, but I do use my own table driven menu builder in my production apps.

Only in the sense that you don't write the menu code line by line. It is also easier to alter this way.....when needed.:yes

xluser2007
03-10-2008, 05:03 PM
Thanks lucas, this will look into this cool tool further!

Bob Phillips
03-10-2008, 07:04 PM
Only in the sense that you don't write the menu code line by line. It is also easier to alter this way.....when needed.:yes

That is what computers are for, to save us work. Nice when for once it actually happens :p

lucas
03-10-2008, 07:34 PM
That is what computers are for, to save us work. Nice when for once it actually happens :p

Ha, that's funny Bob. Seems like I work awfully hard trying to get something(computer) to save me work sometimes....:dunno

Bob Phillips
03-11-2008, 01:15 AM
Yeah, it is like calling Office a productivity tool. I often think that when Word messes up my bullets and I spend half an hour trying to get them back as I want them, or when I spend two hours searching 2007 ribbon to find that command that is so familiar to me in 2003.

xluser2007
03-15-2008, 05:47 PM
Hi xld, lucas and VBAX readers,

With your help, I have now managed to create a working version of the addin. I am therefore marking the thread solved as you have helped create the main VALUES-ONLY of Active workbook macro. I am very appreciative of your help :hi:.

The code is posted below for anyone to else to use (disclaimer: use at your own discretion):


'Option Explicit
'---------------------------------------------------------------------------------------
' Module : Create_values_only_Activeworkbook
' Author : XLUSER2007
' Date : 16/03/2008
' Purpose : This macro creates a VALUES-ONLY version of your Activeworkbook.
' e.g. if you have C:\Docs\Spreadsheettest.xls open and run the macro
' - the macro will take the Activeworkbook and;
' 1. Delete all comments
' 2. Remove all highlighting (NOT conditional formatting)
' 3. Remove all worksheet tab colours
' 4. Paste over entire workbook as VALUES-ONLY i.e. no formulas or
' external links visible
' 5. - If 'C:\Docs\Values' folder exists then it will save Activeworkbook
' as 'C:\Docs\Values\Spreadsheettest_Values only.xls'
' - If 'C:\Docs\Values' folder doesn't exist, it will give the user the
' option to create this folder and save Activeworkbbok as:
' 'C:\Docs\Values\Spreadsheettest_Values only.xls'
' 6. Once 'C:\Docs\Values\Spreadsheettest_Values only.xls' is created,
' the Activeworkbook will auomatically Save and Close.
'
' NOTE: The original workbook WILL not be affected in this Save process
' however system failures may arise and this macro should be used at own
' discretion.'
'---------------------------------------------------------------------------------------
'

Sub BuildToolBar()
' remove the toolbar if it exists and create it from scratch
Dim cb As CommandBar, cbc As CommandBarControl
Dim Buttons(1, 1 To 3) ' caption, macro, faceid
Dim i As Integer

' remove existing instances of toolbar
DeleteToolbar

' create new toolbar
Set cb = CommandBars.Add("Values only workbook creator", msoBarTop)
cb.Visible = True

' populate buttons array
Buttons(1, 1) = "Create Values only workbook": Buttons(1, 2) = _
"Create_values_only_Activeworkbook": Buttons(1, 3) = 591

' add buttons to toolbar

Set cbc = cb.Controls.Add(Type:=msoControlButton)
With cbc
.Caption = Buttons(1, 1)
.OnAction = Buttons(1, 2)
.FaceId = Buttons(1, 3)
.Style = msoButtonIconAndCaption
End With

' remove objects from memory
Set cb = Nothing
Set cbc = Nothing
End Sub

Sub DeleteToolbar()
' remove the toolbar if it exists
Dim cb As CommandBar

For Each cb In CommandBars
If cb.Name = "Values only workbook creator" Then cb.Delete
Next cb
End Sub

Sub Create_values_only_Activeworkbook()
Dim cmt As Comment
Dim SourcewbkFilePath As String
Dim TargetFilePath As String
Dim TargetFileName As String
Dim Full_TargetFilePath_and_Name As String
Dim ws As Worksheet
Dim Sourcewbk As Workbook
Dim Sourcewbkname As String
Dim shortsourcewbkname As String

With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With

Set Sourcewbk = ActiveWorkbook

SourcewbkFilePath = Sourcewbk.Path
Debug.Print SourcewbkFilePath

TargetFilePath = SourcewbkFilePath & "\Values"
Debug.Print TargetFilePath

Sourcewbkname = Sourcewbk.Name
Debug.Print Sourcewbkname

shortsourcewbkname = Left(Sourcewbkname, Len(Sourcewbkname) - 4)
Debug.Print shortsourcewbkname

TargetFileName = shortsourcewbkname & "_values only" & ".xls"
Debug.Print TargetFileName

Full_TargetFilePath_and_Name = TargetFilePath & "\" & TargetFileName
Debug.Print Full_TargetFilePath_and_Name

If Not DirExists(TargetFilePath) Then

Select Case MsgBox("Would you like to create a new VALUES-ONLY folder?" _
& vbCrLf & "" _
& vbCrLf & TargetFilePath _
& vbCrLf & "" _
& vbCrLf & "and also create the corresponding VALUES-ONLY file?" _
& vbCrLf & "" _
& vbCrLf & TargetFileName _
& vbCrLf & "" _
& vbCrLf & " in this folder?" _
, vbYesNo Or vbExclamation Or vbDefaultButton1, _
"The VALUES-ONLY folder doesn't exist, create it?")

Case vbYes
Call MkDir(TargetFilePath)
Call ChDir(TargetFilePath)

Case vbNo
GoTo end_program_handler_without_creating_values_only_file

End Select
End If

Sourcewbk.SaveAs Filename:=Full_TargetFilePath_and_Name

For Each ws In ActiveWorkbook.Worksheets

With ws.UsedRange

.Value = .Value
.Interior.ColorIndex = xlColorIndexNone
End With

For Each cmt In ws.Comments
cmt.Delete
Next

ws.Tab.ColorIndex = xlColorIndexNone
Next ws

With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With

ActiveWorkbook.Close SaveChanges:=True

GoTo End_with_successful_values_only_version_created

end_program_handler_without_creating_values_only_file:
MsgBox ("The Values only folder " & TargetFilePath & _
" and;" & vbCrLf & "The corresponding values only file " _
& TargetFileName & " weren't created")

End_with_successful_values_only_version_created:

End Sub

Function DirExists(strDir) As Boolean
'John Walkenbach interesting method
Dim x As String
On Error Resume Next
x = GetAttr(strDir) And 0
If Err = 0 Then DirExists = True Else DirExists = False
End Function



Then in the "Thisworkbook" section, paste in the following code:
Private Sub Workbook_Open()

Call BuildToolBar

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Call DeleteToolbar

End Sub
And also in "Thisworkbook" properties set the IsAddin condition = True.

Then save as an Excel Addin (*.xla) file and close and re-open Excel and Install from Tools>Addins and your done.

Having said all this, having designed the macro through your generous help xld and lucas, I would like to build on it and make it more robust, in the following ways:

1. Basic issue is if the Activeworkbook is not saved, this creates a values-only version and closes of the activeworkbook without saving, but creates the relevant values only version. I would like to build an option to allow them save the active workbook (YesNo or cancel) and then continue with closing and creaiting the values only workbook. Are there any ways that ways that you can suggest on how to amend for this?

2. Ideally the value sonly workbook should be a Copy of the currently open Activeworkbook that you apply the macro to i.e. Say you have created a budget.xls and saved it, you want to be able to run this macro (i.e. create Budget_values only.xls), but would still like the budget.xls original spreadsheet to remain open/ active so you can keep working on it. How would you go about doing this? My guess was to write some code so that the amcro makes a Copy of the Activeworkbook in its current form and create a values-only on that. Any ideas on how to amend for this?

3. If you open up a new workbook it is automatically stored in a temporary directory and if you try running the macro it saves to a temporary directory which bis a problem. Giving the user the option to save the Activeworkbook first in a non-temporary directory would be ideal i.e. macro should be able to realise that activeworkbook is in the temprary directory and give option to save ina non-temporary directory and then, then-ONLY create a values only version on that path. How would I go about correcting for this?

4. Aside from the above 3 changes is there any way to make the above code more efficient or look cleaner (not the bit you guys gave, but anything that I've added to it e.g. leaving out GoTo statements altogether or anything that you see as poor coding practice)?

Any help on the above points would really help me undertsand VBA better, make this macro more robust and I;m sure help out other newbies.

Again thanks for your help.

regards

lucas
03-15-2008, 06:38 PM
The saving the active workbook part is easy. just use this and put it just before your set statments....look for the If statement in your code and add the activeworkbook.save line just after it.

activeworkbook.save
If Not DirExists(TargetFilePath) Then


that will save the activeworkbook to it's default direcory....you can get more elaborate and give it a path if you want or even more elaborat and open a browse for folder so the user can select a location to save the activeworkbook.....

xluser2007
03-15-2008, 11:22 PM
Hi lucas, Thanks for that feedback

I have adapted your code, experimented and searched around and come up with the following code to tackle problem #1 as listed below.

Option Explicit
'---------------------------------------------------------------------------------------
' Module : Create_values_only_Activeworkbook
' Author : XLUSER2007
' Date : 16/03/2008
' Purpose : This macro creates a VALUES-ONLY version of your Activeworkbook.
' e.g. if you have C:\Docs\Spreadsheettest.xls open and run the macro
' - the macro will take the Activeworkbook and;
' 1. Delete all comments
' 2. Remove all highlighting (NOT conditional formatting)
' 3. Remove all worksheet tab colours
' 4. Paste over entire workbook as VALUES-ONLY i.e. no formulas or
' external links visible
' 5. - If 'C:\Docs\Values' folder exists then it will save Activeworkbook
' as 'C:\Docs\Values\Spreadsheettest_Values only.xls'
' - If 'C:\Docs\Values' folder doesn't exist, it will give the user the
' option to create this folder and save Activeworkbbok as:
' 'C:\Docs\Values\Spreadsheettest_Values only.xls'
' 6. Once 'C:\Docs\Values\Spreadsheettest_Values only.xls' is created,
' the Activeworkbook will auomatically Save and Close.
'
' NOTE: The original workbook WILL not be affected in this Save process
' however system failures may arise and this macro should be used at own
' discretion.'
'---------------------------------------------------------------------------------------
'

Sub BuildToolBar()
' remove the toolbar if it exists and create it from scratch
Dim cb As CommandBar, cbc As CommandBarControl
Dim Buttons(1, 1 To 3) ' caption, macro, faceid
Dim i As Integer

' remove existing instances of toolbar
DeleteToolbar

' create new toolbar
Set cb = CommandBars.Add("Values only workbook creator", msoBarTop)
cb.Visible = True

' populate buttons array
Buttons(1, 1) = "Create Values only workbook": Buttons(1, 2) = _
"Create_values_only_Activeworkbook": Buttons(1, 3) = 591

' add buttons to toolbar

Set cbc = cb.Controls.Add(Type:=msoControlButton)
With cbc
.Caption = Buttons(1, 1)
.OnAction = Buttons(1, 2)
.FaceId = Buttons(1, 3)
.Style = msoButtonIconAndCaption
End With

' remove objects from memory
Set cb = Nothing
Set cbc = Nothing
End Sub

Sub DeleteToolbar()
' remove the toolbar if it exists
Dim cb As CommandBar

For Each cb In CommandBars
If cb.Name = "Values only workbook creator" Then cb.Delete
Next cb
End Sub

Sub Create_values_only_Activeworkbook()
Dim cmt As Comment
Dim SourcewbkFilePath As String
Dim TargetFilePath As String
Dim TargetFileName As String
Dim Full_TargetFilePath_and_Name As String
Dim ws As Worksheet
Dim Sourcewbk As Workbook
Dim Sourcewbkname As String
Dim shortsourcewbkname As String

With Application
.ScreenUpdating = False
' .DisplayAlerts = False
End With

Set Sourcewbk = ActiveWorkbook

SourcewbkFilePath = Sourcewbk.Path
Debug.Print SourcewbkFilePath

TargetFilePath = SourcewbkFilePath & "\Values"
Debug.Print TargetFilePath

Sourcewbkname = Sourcewbk.Name
Debug.Print Sourcewbkname

shortsourcewbkname = Left(Sourcewbkname, Len(Sourcewbkname) - 4)
Debug.Print shortsourcewbkname

TargetFileName = shortsourcewbkname & "_values only" & ".xls"
Debug.Print TargetFileName

Full_TargetFilePath_and_Name = TargetFilePath & "\" & TargetFileName
Debug.Print Full_TargetFilePath_and_Name

Start_ActiveworkbookSaveAs_routine:

Dim dlgSaveAs As FileDialog
Dim strFile As String

Select Case MsgBox("Do you want to do the following?" _
& vbCrLf & "" _
& vbCrLf & "Yes: SAVE this workbook as " & SourcewbkFilePath & "\" _
& Sourcewbkname & " and continue." _
& vbCrLf & "" _
& vbCrLf & "No: SAVE this workbook as a DIFFERENT filename and continue" _
& vbCrLf & "" _
& vbCrLf & "Cancel: DON'T SAVE this workbook at all and continue" _
, vbYesNoCancel Or vbExclamation Or vbDefaultButton1, _
"This workbook is NOT currently saved")

Case vbYes

ActiveWorkbook.Save

Case vbNo

Set dlgSaveAs = Application.FileDialog(msoFileDialogSaveAs)
dlgSaveAs.Show

On Error Resume Next
strFile = dlgSaveAs.SelectedItems(1)
If Err Then MsgBox "Cancel was pressed! And the workbook wasn't saved": _
GoTo Start_ActiveworkbookSaveAs_routine
ActiveWorkbook.SaveAs strFile

MsgBox "You saved the file to:" & vbNewLine & strFile

Case vbCancel

GoTo continue_without_Saving_Activeworkbook

End Select

continue_without_Saving_Activeworkbook:

If Not DirExists(TargetFilePath) Then

Select Case MsgBox("Would you like to create a new VALUES-ONLY folder?" _
& vbCrLf & "" _
& vbCrLf & TargetFilePath _
& vbCrLf & "" _
& vbCrLf & "and also create the corresponding VALUES-ONLY file?" _
& vbCrLf & "" _
& vbCrLf & TargetFileName _
& vbCrLf & "" _
& vbCrLf & " in this folder?" _
, vbYesNo Or vbExclamation Or vbDefaultButton1, _
"The VALUES-ONLY folder doesn't exist, create it?")

Case vbYes
Call MkDir(TargetFilePath)
Call ChDir(TargetFilePath)

Case vbNo
GoTo end_program_handler_without_creating_values_only_file

End Select
End If

Sourcewbk.SaveAs Filename:=Full_TargetFilePath_and_Name

For Each ws In ActiveWorkbook.Worksheets

With ws.UsedRange

.Value = .Value
.Interior.ColorIndex = xlColorIndexNone
End With

For Each cmt In ws.Comments
cmt.Delete
Next

ws.Tab.ColorIndex = xlColorIndexNone
Next ws

With Application
' .DisplayAlerts = True
.ScreenUpdating = True
End With

ActiveWorkbook.Close SaveChanges:=True

GoTo End_with_successful_values_only_version_created

end_program_handler_without_creating_values_only_file:
MsgBox ("The Values only folder " & TargetFilePath & _
" and;" & vbCrLf & "The corresponding values only file " _
& TargetFileName & " weren't created")

End_with_successful_values_only_version_created:

End Sub

Function DirExists(strDir) As Boolean
'John Walkenbach interesting method
Dim x As String
On Error Resume Next
x = GetAttr(strDir) And 0
If Err = 0 Then DirExists = True Else DirExists = False
End Function

This way the user is given the option to Save the Activeworkbook, or not increasing flexibility for the user. Do you agree with the above code, is it well written or are there better ways to call the Save As dialog? (Note: The code with the dlgSaveAs.show etc is froma post by firefytr from a previous great VBAX entry :thumb)

The issues #2 (Saving as a copy and keeping the activeworkbook open), #3 (refusing to continue of the file is not saved in a non-temp directory) still remain......

Your thoughts and feedback on solving the above issues would be really apprecaited?

lucas
03-16-2008, 07:04 AM
You're getting there aren't you? I personally find all of the dialogs a little off putting but I am used to getting it to do what I want it to do. You are probably working with multiple users so you have to adapt to your need.

Please use line breaks in your code. Many folks don't have wide screens yet......me for one....I added breaks to your code in two posts above...

for question 2 It might be a little more difficult.....

xluser2007
03-16-2008, 10:35 PM
Hi lucas, thanks for your feedback.

Firstly, apologies for not putting in breaks between the lines. Will do so henceforth.

With regards to the problems at hand, I'm still stumped I'm afraid. In the email notification you gave me the hint Set sourcewbk = Activeworkbook. Don't yet follow but will persist on. (I'm not sure why it didn;t appear in the forum message above :think:)

I tried using the method of changing
Sourcewbk.SaveAs Filename:=Full_TargetFilePath_and_Name

to:

Sourcewbk.SaveCopyAs Filename:=Full_TargetFilePath_and_Name

this didn't work as I'd liked it to though and did the same thing, shut off all Activeworkbooks.

Any more hints or wise counsel to get me closer to the goal?

Thanks for your help and look forward to anymore thoughts you may have.

regards

xluser2007
03-20-2008, 06:58 PM
Hi VBAXer's,

In the code for creating values only version of the Activeworkbook, the code fails in the line:

With ws.UsedRange

.Value = .Value
.Interior.ColorIndex = xlColorIndexNone
End With

when the Activeworkbbok (and the relevant worksheet that the code is applied to) contains Pivottables, becasue you can't manually alter a pivottable.

Is there a workaround for this code to accomodate for Pivottables VB Gurus?

Also, I still can't get #2 of my queries in post #36, can anyone please help this me out on this workaround. I'm hoping to make this a really versatile addin personal use and for distribution to colleagues who need to always create values only versions of the activeworkbooks for clients.

Any guidance on assiting me in this query also appreciated.

regards,

xluser2007
03-21-2008, 02:59 AM
Hi All,

I've been playing around with this problem more.

For value-pasting over all worksheets ion a workbook, you can select the sheet then, select all the cells (hit square above row 1 and left of column A) and then paste special>Paste values.

I tried this on a worksheet containing a pivottable and recorded the process as a macro:

Sub pivot_value_paste()

' pivot_value_paste Macro

Cells.Select
Selection.Copy
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
The pivot table then gets value-pasted over as desired.

How can this be generalised to the original code for any type of workbook with any number and names of sheets?

mdmackillop
03-21-2008, 03:39 AM
How is this different from Post 2?

xluser2007
03-21-2008, 03:55 AM
Hi malcolm,

You're very right!

It is not different to posts #2. I also mentioned the issue of this code not working for me #6 and also #8 tried to the say the similar thing.

Bob, circumvented the values paste approach of #2, and gave a great alternative to this approach as is explicit in #41. This approach however doesn't work for pivot tables though, which is the current issue at-hand for me. Which is why I'm trying to revist #2 approach and seeeing if this approach can be generalised.

I'm honestly not sure why lucas's code in #2 didn't work for me and would like to know, as revising it may help correct for this pivot-table issue.

I hope that gives you a better idea of what I'm trying to understand.

xluser2007
03-21-2008, 05:28 PM
Hi All,,

Happy Easter if you celebrate it.

I'm still wrestling with this bugger. Any thoughts gurus, as can be seen from my previous posts. I have reached the 'back to square one approach'.

My question is why dies value pasting over an entire worksheet not affect pivot-tables (i.e. they correctly paste over themselves without error)? And then why does Bob's method above not work. in principle they are the same thing, one just pastes over the entire table, one tries cell by cell. At the end of the day the pivot-table object is still modified.

Any thoughts and suggestions for amendments Gurus?

xluser2007
03-21-2008, 09:48 PM
I've put the Pivot-table query aside for now, if you have a solution please let me know.

As for taking a copy of the activeworkbook, making it values-only and then closing the values-only version, but keeping the original open: Stumbled ontop this Word analogue by lucas:

http://www.vbaexpress.com/kb/getarticle.php?kb_id=961

How do I use this to solve the above query?

Anyone feel free to jump in and let me know

xluser2007
03-23-2008, 02:53 AM
Hi All,

Ok, after searching around I came across the following bit of Code from Ozgrid, written by Aaron Blood (modified slightly) that solves the pivot table value paste issue.

It is, as was written in earlier posts , using the method of selecting all worksheets in the Activeworkbook as an array and copying all cells and pasting over as values only:

Option Explicit

Sub Worksheet_Array_Values_Paste_Activeworkbook()

Dim wksht As Worksheet
HidShts As New Collection
For Each wksht In ActiveWorkbook.Worksheets
If Not wksht.Visible Then
HidShts.Add wksht
wksht.Visible = xlSheetVisible
End If
Next wksht

Worksheets.Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Select
Application.CutCopyMode = False

' Use the following code TO REHIDE or DELETE unhidden sheets when value paste takes place

' For Each wksht In HidShts
' ' wksht.Delete
' wksht.Visible = xlSheetHidden
' Next wksht

End Sub
As can be seen it makes provisions to unhide all worksheets before group selecting them, and also gives thye opportunity to delete or re-hide them (very nice, but cpommented out for my purposes).

Then in my main code, all i have to do is write:


' This creates the VALUES-ONLY version of the Activeworkbook by calling on the macro below

Call Worksheet_Array_Values_Paste_Activeworkbook


Now only 2 things remain before this becomes a well functioning Add-in, pasted over from post #36:

2. Ideally the value sonly workbook should be a Copy of the currently open Activeworkbook that you apply the macro to i.e. Say you have created a budget.xls and saved it, you want to be able to run this macro (i.e. create Budget_values only.xls), but would still like the budget.xls original spreadsheet to remain open/ active so you can keep working on it. How would you go about doing this? My guess was to write some code so that the amcro makes a Copy of the Activeworkbook in its current form and create a values-only on that. Any ideas on how to amend for this?

3. If you open up a new workbook it is automatically stored in a temporary directory and if you try running the macro it saves to a temporary directory which bis a problem. Giving the user the option to save the Activeworkbook first in a non-temporary directory would be ideal i.e. macro should be able to realise that activeworkbook is in the temprary directory and give option to save ina non-temporary directory and then, then-ONLY create a values only version on that path. How would I go about correcting for this?

Bob, malcolm, lucas, or any other VBGuru's care to help me finish this problem off :) (my full code at present is pasted right below):

regards

Option Explicit
'---------------------------------------------------------------------------------------
' Module : Create_values_only_Activeworkbook
' Author : XLUSER2007
' Date : 16/03/2008
' Purpose : This macro creates a VALUES-ONLY version of your Activeworkbook.
' e.g. if you have C:\Docs\Spreadsheettest.xls open and run the macro
' - the macro will take the Activeworkbook and;
' 1. Delete all comments
' 2. Remove all highlighting (NOT conditional formatting)
' 3. Remove all worksheet tab colours
' 4. Paste over entire workbook as VALUES-ONLY i.e. no formulas or
' external links visible
' 5. - If 'C:\Docs\Values' folder exists then it will save Activeworkbook
' as 'C:\Docs\Values\Spreadsheettest_Values only.xls'
' - If 'C:\Docs\Values' folder doesn't exist, it will give the user the
' option to create this folder and save Activeworkbbok as:
' 'C:\Docs\Values\Spreadsheettest_Values only.xls'
' 6. Once 'C:\Docs\Values\Spreadsheettest_Values only.xls' is created,
' the Activeworkbook will auomatically Save and Close.
'
' NOTE: The original workbook WILL not be affected in this Save process
' however system failures may arise and this macro should be used at own
' discretion.'
'---------------------------------------------------------------------------------------
'

Sub BuildToolBar()
' remove the toolbar if it exists and create it from scratch
Dim cb As CommandBar, cbc As CommandBarControl
Dim Buttons(1, 1 To 3) ' caption, macro, faceid
Dim i As Integer

' remove existing instances of toolbar
DeleteToolbar

' create new toolbar
Set cb = CommandBars.Add("Values only workbook creator", msoBarTop)
cb.Visible = True

' populate buttons array
Buttons(1, 1) = "Create Values only workbook": Buttons(1, 2) = _
"Create_values_only_Activeworkbook": Buttons(1, 3) = 591

' add buttons to toolbar

Set cbc = cb.Controls.Add(Type:=msoControlButton)
With cbc
.Caption = Buttons(1, 1)
.OnAction = Buttons(1, 2)
.FaceId = Buttons(1, 3)
.Style = msoButtonIconAndCaption
End With

' remove objects from memory
Set cb = Nothing
Set cbc = Nothing
End Sub

Sub DeleteToolbar()
' remove the toolbar if it exists
Dim cb As CommandBar

For Each cb In CommandBars
If cb.Name = "Values only workbook creator" Then cb.Delete
Next cb
End Sub

Sub Create_values_only_Activeworkbook()
Dim cmt As Comment
Dim SourcewbkFilePath As String
Dim TargetFilePath As String
Dim TargetFileName As String
Dim Full_TargetFilePath_and_Name As String
Dim ws As Worksheet
Dim Sourcewbk As Workbook
Dim Sourcewbkname As String
Dim shortsourcewbkname As String

With Application
.ScreenUpdating = False
' .DisplayAlerts = False
End With

Set Sourcewbk = ActiveWorkbook

SourcewbkFilePath = Sourcewbk.Path
Debug.Print SourcewbkFilePath

TargetFilePath = SourcewbkFilePath & "\Values"
Debug.Print TargetFilePath

Sourcewbkname = Sourcewbk.Name
Debug.Print Sourcewbkname

shortsourcewbkname = Left(Sourcewbkname, Len(Sourcewbkname) - 4)
Debug.Print shortsourcewbkname

TargetFileName = shortsourcewbkname & "_values only" & ".xls"
Debug.Print TargetFileName

Full_TargetFilePath_and_Name = TargetFilePath & "\" & TargetFileName
Debug.Print Full_TargetFilePath_and_Name

Start_ActiveworkbookSaveAs_routine:

Dim dlgSaveAs As FileDialog
Dim strFile As String

Select Case MsgBox("Do you want to do the following?" _
& vbCrLf & "Yes: SAVE this workbook as " & SourcewbkFilePath & "\" _
& Sourcewbkname & " and continue." _
& vbCrLf & "No: SAVE this workbook as a DIFFERENT filename and continue" _
& vbCrLf & "Cancel: DON'T SAVE this workbook at all and continue" _
, vbYesNoCancel Or vbExclamation Or vbDefaultButton1, _
"This workbook is NOT currently saved")

Case vbYes

ActiveWorkbook.Save

Case vbNo

Set dlgSaveAs = Application.FileDialog(msoFileDialogSaveAs)
dlgSaveAs.Show

On Error Resume Next
strFile = dlgSaveAs.SelectedItems(1)
If Err Then MsgBox "Cancel was pressed! And the workbook wasn't saved": _
Goto Start_ActiveworkbookSaveAs_routine
ActiveWorkbook.SaveAs strFile

MsgBox "You saved the file to:" & vbCrLf & strFile

Case vbCancel

Goto continue_without_Saving_Activeworkbook

End Select

continue_without_Saving_Activeworkbook:

If Not DirExists(TargetFilePath) Then

Select Case MsgBox("Would you like to create a new VALUES-ONLY folder?" _
& vbCrLf & TargetFilePath _
& vbCrLf & "and also create the corresponding VALUES-ONLY file?" _
& vbCrLf & TargetFileName _
& vbCrLf & " in this folder?" _
, vbYesNo Or vbExclamation Or vbDefaultButton1, _
"The VALUES-ONLY folder doesn't exist, create it?")

Case vbYes

Call MkDir(TargetFilePath)
Call ChDir(TargetFilePath)

Case vbNo

Goto end_program_handler_without_creating_values_only_file

End Select

End If

Sourcewbk.SaveAs Filename:=Full_TargetFilePath_and_Name

' This creates the VALUES-ONLY version of the Activeworkbook by calling on the macro below
Call Worksheet_Array_Values_Paste_Activeworkbook

For Each ws In ActiveWorkbook.Worksheets

With ws.UsedRange

.Interior.ColorIndex = xlColorIndexNone

' The following line was the original code to create a VALUES-ONLY version of the activeworkbook, but fails when applied to PIVOT-TABLES, hence is removed.
' It is replced by the above code: Call Worksheet_Array_Values_Paste_Activeworkbook
' .Value = .Value

End With

For Each cmt In ws.Comments

cmt.Delete

Next

ws.Tab.ColorIndex = xlColorIndexNone

Next ws

With Application

' .DisplayAlerts = True
.ScreenUpdating = True

End With

ActiveWorkbook.Close SaveChanges:=True

Goto End_with_successful_values_only_version_created

end_program_handler_without_creating_values_only_file:
MsgBox ("The Values only folder " & TargetFilePath & _
" and;" & vbCrLf & "The corresponding values only file " _
& TargetFileName & " weren't created")

End_with_successful_values_only_version_created:

End Sub

Function DirExists(strDir) As Boolean
'John Walkenbach interesting method
Dim x As String
On Error Resume Next
x = GetAttr(strDir) And 0
If Err = 0 Then DirExists = True Else DirExists = False
End Function


' The following macro was sourced from http://www.ozgrid.com/forum/showthread.php?t=38064
' Written by Aaron Blood
' Key trick to creating the VALUES-ONLY version of Activeworkbook is to select all sheets as an array and
' copy and paste-special over as values-only. Very quick.
' It also makes provisions to unhide all HIDDEN worksheets before the value-paste is conducted for the Activeworkbook.

Option Explicit

Sub Worksheet_Array_Values_Paste_Activeworkbook()

Dim wksht As Worksheet
HidShts As New Collection
For Each wksht In ActiveWorkbook.Worksheets
If Not wksht.Visible Then
HidShts.Add wksht
wksht.Visible = xlSheetVisible
End If
Next wksht

Worksheets.Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Select
Application.CutCopyMode = False

' Use the following code TO REHIDE or DELETE unhidden sheets when value paste takes place

' For Each wksht In HidShts
' ' wksht.Delete
' wksht.Visible = xlSheetHidden
' Next wksht

End Sub

Bob Phillips
03-23-2008, 03:07 AM
#2 - aren't you already doing this where you use the SaveAs dialog, the user has to specify a folder?

#3 replace


ActiveWorkbook.SaveAs strFile


with



ActiveWorkbook.SaveCopyAs strFile

xluser2007
03-23-2008, 03:38 AM
Bob, as usual thanks for your prompt replies. Here are my (tested) comments to your queries and suggestions.


#2 - aren't you already doing this where you use the SaveAs dialog, the user has to specify a folder?
Not really, as the user can hit CANCEL, i.e. not save the asctivefile that they are working on and create the VALUES-ONLY version.

The problem is that in the code, whether they hit YES, NO or CANCEL in terms of svaing their original, once the values only version is created and the all activeworkbooks are closed off, leaving a blank excel window. Onece the VALUES-ONLY version is created, I would like orginal workbook to remain (in whatever saved, changed or unsaved format that the user opted for), so that the user can keep working on it.

This is not really addressed in the above code, or am I missing the point in your comment Bob?


#3 replace

VBA:

ActiveWorkbook.SaveAs strFile

VBA tags courtesy of www.thecodenet.com (http://www.thecodenet.com)

with


VBA:

ActiveWorkbook.SaveCopyAs strFile
I tried this change as suggested. If the user hits CANCEL however, i.e. continues WITHOUT saving the Activeworkbook, the second dialog box in the program allows the user to make a VALUES-ONLY version in the path of the active temporary workbook i.e. in a temporary directory which is undesired.

In this part, I would ideally like the program to work out at the start whether the activeworkbook is in a temporary folder. If it is in a temporary folder, I would want the program to FORCE the user to SAVE in a non-temporary folder and then only continue in creating a VALUES_ONLY version.

The savecopyas didn't work for me though i.e. the above problem still persisted. Is the above possible to do without labrious coding or is there an easy way to determine non-temp directories from temp ones and thus adapt acordingly?

regards

Bob Phillips
03-23-2008, 04:47 AM
I probably got the wring part of code, maybe



Sourcewbk.SaveAs Filename:=Full_TargetFilePath_and_Name


should be the change



Sourcewbk.SaveCopyAs Filename:=Full_TargetFilePath_and_Name

xluser2007
03-23-2008, 05:11 AM
Hi Bob,

Just tried that, but couldn't get it to keep the activeworkbook open. Infact this saved over the original as values-only.

Do you think it's working but the original is remaining hidden?

Is there a way to keep the original and the values-only separate from the start i.e. load the original in memory and then call it back at the end :think:?

Also in the above, more importantly is it an issue with my settings, i.e.d oes the code work for you as I mentioned in rectifying the discussed issues?

Again, thanks for your time on this one, as you can see from my previous posts I genuinely am trying to learn and build something really useful out of this one with your and all the VBAXer's help.

regards,

Bob Phillips
03-23-2008, 06:15 AM
I can't say, I haven't tested it out thoroughly as I can't say that I still fully understand what you are really aiming at.

If you do SaveCopyAs that creates a copy of that workbook, not in memory, but on the disk. You could then open that file and you have the original and the copy open. As ever, it is best to use workbook objects to reference each workbook, then you can easily switch amongst them.

If you do a SaveAs the file gets saved under a new name, but that becomes the active workbook, the original is not in memory any longer.

xluser2007
03-23-2008, 03:56 PM
Hi Bob, thanks for your persistence.

I realise that after reading my queries it's not entirely clear what I want to achieve out of this add-in, so here's a step by-step guide:

What is the end goal is of the exercise?

1. Basically Add-in should create values only of the activeworkbook, remove comments, clear out highlighting, remove tab highlighting at the click of a custom button in the Excel Window applied to the activeworkbook.

As such we are creating an on-the-fly values only version of the activeworkbook, which is pretty cool and handy!

Prompting the user to Save as Current filename, as a differnt filename or not at all and proceed

2. However if the user is working on the activeworkbook say C:\budget.xls and hasn't saved before executing this add-in, I would like the add-in to prompt the user for a vbYesNoCancel Save dialog, here:

YES: Means save as the activeworkbook path and filename.

NO: means save as a different filename e.g. D:\budget_revised.xls

CANCEL: Leave C:\budget.xls in whatever format it is now, and proceed unsaved only to return to working on it once the values only add-in is run and the values-only copy i.e.e C:\Values\budget_values only.xls) is created.

Creating the Values foldeer to save the file

3. Then the add-in will work as performed anc create a values-only workbook, it will prompt the user whether the directory C:\Values should be created first to store the budget_values only.xls, if the user cciks yes then only the file should be created else we should exit the Add-in.

What if the workbook is stored in a Temporary folder?

4. Now there's also another caveat that comes into play. What if the a new workbook is opened, or more practically an emailed attachment workbook is opened.

This file will automatically be stored in a temporary folder in explorer. the add-in should pick this up and at the start allow the user to save to a non-temporary directory on the PC e.g open up the SaveAs dialog box again and then check that it is a non-temp folder). Then only should the Add-in continue to create the values only for this special case file, else it should exit with the MsgBox "The work book [filename] here is in a TEMPORARY folder, please save to a nontemporary drive and then re-run values-only tool"

What happens once the values-only file C:\Values\budget_values only.xls is created?

6. After this is done, the budget,xls original in Step 2 that the user was prompted to Save or not should be recalled and the user should continue to work on it in that form whether they had saved as the same filename, saved as a different filename or not saved at all at that point.

Any other activeworkbooks that were open in the Excel window before creating the values-only version should remian open and in whatever form they were before the addin was run, at the moment we are being left with a blank window as the macro closes off everything including the original!

At the moment the above two queries are not being met in the code.

I hope the above clarifies what the end goal is for my purposes. Sorry of it wasn;t clear earlier.

Any help would be great to knock this one out :).

regards

xluser2007
03-24-2008, 03:06 AM
Hi All,

Still plugging away at this old chestnut :p.

Bob, been testing this one out with varying permutations of savecopy as etc, still no luck.

Was my previous post clearer as to what I'm trying to seek, but not quite achgieving, or was it clear as mud?

Based on that post did you have a chance to test it t out, is it a setting issue for me i.e. in terms of loading the original workbook in memory (changing memory settings) or is it a straight coding issue?

Any thought much appreciated.

Bob Phillips
03-24-2008, 03:15 AM
Don't know yet mate, haven't had time to absorb it all, but looking at it I bet it is.

I have things to do today, but should get to it later today.

xluser2007
03-24-2008, 03:27 AM
Thanks Bob,Please take your time. Whenever you have the free time to look at it (now that's a laugh) please let me know your thoughts and corrections.

Again apprecaite your help on this man, solving this problem has become addictive past-time!

regards,