Need help to modify VBA

kelly1

Well-known Member
Joined
May 11, 2003
Messages
525
I'm hoping someone can help me modify this code

When the code is run it makes a copy and removes the VBA.

What I want it to do is only remove the VBA (shapes) in the range of C2:U145

Could somebody help please?

Regards

Kelly


--------------------------------------------------------------------------------------------------------------------------------------------------------

Sub SaveReport()
Dim fname As String
Dim rng1 As Range
Dim rng2 As Range

Sheets("CSF 323 2").Copy
ActiveWindow.Activate
Application.CutCopyMode = False

With ActiveWorkbook
Set rng1 = Sheets("CSF 323 2").UsedRange

rng1 = rng1.Value
On Error Resume Next
For Each s In ActiveSheet.Shapes
s.Select
s.Delete
Next s
End With

fname = InputBox("Please enter a file name that will associate this to the case e.g. PWC or NRP name. You will then be prompted for a 'Save As' location, save to a location of you choice, and then send to Specialist Trace.")

Application.Dialogs(xlDialogSaveAs).Show fname
ActiveWorkbook.Close

End Sub

--------------------------------------------------------------------------------------------------------------------------------------------------------
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Condition the Statement:

s.Delete


With "If" logic to only work on the Shapes at your wanted location. Some shape have location data like:

Top, Wide, left, botton

That you can use to define that area.

Or, if the shapes of that Type only exist in that location then you can use the type to condition the delete statement?

You need to indicate what these "Shapes" are and from where you built them or what you used to place them as Excel has many types: Forms, Controls, XML and drawing!
 
Upvote 0
That sounds a bit complicated.

What I am doing is copying the worksheet containg formulas to a new file, to then be transfered to another person to continue working on the form further down. What I need is check boxes on the pages following for him to complete.

As it is now they will all be deleted in that code.


Isn.t there a way of just restricting the s.Delete to C2:U145

This would allow the check boxes on the following pages to remain.

Thanks for any help
 
Upvote 0
A Cell Range has nothing to do with the location of a Shape, thats the problem; Shapes are positioned by the relative displacement from the top most left pixel of the Screen, above the Toolbar and above the first Cell on the Sheet!

Position is mesured in the number of pixels from the screen home position to the Shape.

This is not tested but you may be able to add a nother test loop below or inplace of your first one, to test for shapes within a cell range?
Not Tested!


Set myRngS = ActiveSheet.Range("C2:U145")

For Each shp In myRngS
s.Delete
Next shp
 
Upvote 0
Hi Joe

I just tried that modification and it seem to work ok.

Thanks for your help

This is what I modified the cosde to:


Sub SaveReport()
Dim fname As String
Dim rng1 As Range
Dim rng2 As Range

Sheets("CSF 323 2").Copy
ActiveWindow.Activate
Application.CutCopyMode = False

With ActiveWorkbook
Set rng1 = Sheets("CSF 323 2").UsedRange

rng1 = rng1.Value
On Error Resume Next
Set myRngS = ActiveSheet.Range("C2:U145")

For Each shp In myRngS
s.Delete
Next shp
End With

fname = InputBox("Please enter a file name that will associate this to the case e.g. PWC or NRP name. You will then be prompted for a 'Save As' location, save to a location of you choice, and then send to Specialist Trace.")

Application.Dialogs(xlDialogSaveAs).Show fname
ActiveWorkbook.Close

End Sub
 
Upvote 0

Forum statistics

Threads
1,226,498
Messages
6,191,376
Members
453,655
Latest member
lasvegasbuffet

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top