Solved: Macro to creat a values only version of Activeworkbook

[xluser2007]

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):

1. Create a copy of the Active workbook - call it say newvaluesworkbook in VBA.
2. In newvaluesworkbook. select all worksheets and globally value paste over their existing cells - thus making it values only.
3. All cells in newvaluesworkbook should have no highlighting i.e. Colorindex = Xlnone.
4. Set all tab colours in newvaluesworkbook to have "No Colour"
5. Delete all comments in newvaluesworkbook.
6. 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
7. 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:

[vba]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[/vba]
If anyone could please anyone please guide me in writing the above, I would really appreciate it.

[lucas]

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.

[VBA]
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
[/VBA]

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]

Thanks lucas, that was great help, didin't know the "path" command before.

Here are the amendments I have made so far:

[vba]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[/vba]
Up to the [vba]For Each ws In ActiveWorkbook.Worksheets[/vba] 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]

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
[VBA]Sourcewbk.SaveAs Filename:=Full_TargetFilePath_and_Name[/VBA]
to
[VBA]
Sourcewbk.SaveAs Filename:=Full_TargetFilePath_and_Name & ".xls"
[/VBA]

[xluser2007]

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.

[vba]Set target_valuesonly_wbk = Sourcewbk.SaveAs Filename:=Full_TargetFilePath_and_Name & ".xls"[/vba]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:

[vba]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 [/vba]
Thank you for your help and patience, newbies like me appreciate this.

regards

[xluser2007]

I played around more and here is the resulting VBA code:

[vba]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
[/vba]
This code though, doesn;t paste over the original sheet links and formulas as values only (as it should):

[vba] 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[/vba]
I can't understand why. Could anyone please explain how to correct. I would be really appreciate it.

[Bob Phillips]

[vba]


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
[/vba]

[xluser2007]

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:

[vba]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[/vba]
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]

See if this quicker

[vba]

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
[/vba]

Trust me!

[xluser2007]

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.

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

Thanks again.

[xluser2007]

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]

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]

You could whack this in at the end of the code

[vba]

Dim vbMod As Object

Set vbMod = ActiveWorkbook.VBProject.VBComponents("Module1")
ThisWorkbook.VBProject.VBComponents.Remove vbMod
[/vba]

but all of the code is gone forever then.

[lucas]

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]

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:

[vba]Set vbMod = ActiveWorkbook.VBProject.VBComponents("Module1")[/vba]
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]

I just earched around a bit more and have now made the code as follows:

[VBA]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[/VBA]

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]

Is your module called Module1?

[xluser2007]

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]

I tried to work with this further and went to Chip Pearsons useful website.

I found the following code to delete a module:

[VBA] 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[/VBA]


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 from the values only version.

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

[lucas]

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....

[VBA]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
[/VBA]