View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Risky Dave Risky Dave is offline
external usenet poster
 
Posts: 161
Default path to macros being changed

Simon,

Thanks. just tried this and no difference - the path is still being changed
to point at the newly created workbook.

Dave

"Simon Lloyd" wrote:


Dave, for each of your macro's make sure it is set to the actual name of
the workbook in the dropdown, the problem is because you have it set to
this workbook, when creating a new workbook (thats copying the extracted
worksheet) it becomes the "This Workbook", this workbook also means the
active workbook.
Risky Dave;363964 Wrote:
Simon,

Thanks for the quick response.

This is part of what is being changed! I am setting the macro path to
"This
Workbook" but when Extract is run this is chnaged to "All open
Workbooks".

The workbook is prretty big (about 800k with no data in it), but here's
the
full code for Extract (I don't claim to be a programmer, so I'm sure
that it
could be improved in all sorts of ways - sughestions always welcome!):


Code:
--------------------

Sub Risk_extract()

Dim rNumberCount As Range ' used to track risk numbers
Dim rHistoryCell As Range ' used to track history entries per risk
Dim sStorage As String ' used to store concatenated entries
Dim rExtractCell As Range ' used to place history data on the extract sheet
Dim rCostDataS As Range ' used to transpose cost data in "Extract"
(source)
Dim rCostDataT As Range ' used to transpose cost data into "Extract"
(target)
Dim iNumberOfRows As Integer ' count number of costing rows to transpose
Dim lNumberOfColumns As Long ' count number of costing risks to transpose
Dim sMyRegister As String ' used to capture the name of the current workbook
Dim sMyPath As String ' used to create the save path for the extract

Application.ScreenUpdating = False
sMyPath = Sheets("user data").Range("b4")

'copy basic risk information

Sheets("Identification").Range("a5:o505").copy

Sheets.Add.Name = "Extract"
With Sheets("extract")
.Range("A1").Select
.Paste
.Rows("1:1").Select
.Application.CutCopyMode = False
.Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End With

' concatenate history into column p

Set rNumberCount = Sheets("History storage").Range("a1")
Set rHistoryCell = rNumberCount.Offset(1, 0)
Set rExtractCell = Sheets("extract").Range("p4")
sStorage = ""

Do
If rNumberCount = "" Then
Exit Do
Else
Do
If rHistoryCell.Value < "" Then
sStorage = sStorage & rHistoryCell.Value & Chr(10)
Set rHistoryCell = rHistoryCell.Offset(1, 0)
Else
rExtractCell.Value = sStorage
Exit Do
End If
Loop
Set rNumberCount = rNumberCount.Offset(0, 1)
Set rHistoryCell = rNumberCount.Offset(1, 0)
Set rExtractCell = rExtractCell.Offset(1, 0)
sStorage = ""
End If
Loop

' copy risk register pages to temporary storage called Extract

Sheets("assessment").Range("c5:r505").copy
Sheets("extract").Select
Range("p1").Select
ActiveSheet.Paste

Sheets("treatment - controls").Range("c5:r505").copy
Sheets("extract").Select
Range("af1").Select
ActiveSheet.Paste

Sheets("treatment - mitigations").Range("c5:w505").copy
Sheets("extract").Select
Range("av1").Select
ActiveSheet.Paste

Sheets("treatment - contingency").Range("c5:e505").copy
Sheets("extract").Select
Range("bq1").Select
ActiveSheet.Paste

' create costing data headings

Range("bt3").Value = "Mitigation 1 Cost"
Range("bu3").Value = "Mitigation 2 Cost"
Range("bv3").Value = "Mitigation 3 Cost"
Range("bw3").Value = "Mitigation 4 Cost"
Range("bx3").Value = "Mitigation 5 Cost"
Range("by3").Value = ""
Range("bz3").Value = ""
Range("ca3").Value = ""
Range("cb3").Value = ""
Range("cc3").Value = "Unmitigated Exposure"
Range("cd3").Value = "Cost To Mitigate"
Range("ce3").Value = "Mitigated Exposure"
Range("cf3").Value = "Recommendation"
Range("cg3").Value = "Threat/Opportunity"
Range("ch3").Value = "Cost of Risk"

' transpose cost data in "extract"

Set rCostDataS = Sheets("costings").Range("a3")
Set rCostDataT = Sheets("extract").Range("bt4")
iNumberOfRows = 16
lNumberOfColumns = rCostDataS.End(xlToRight).Column - rCostDataS.Column + 1

rCostDataS.Resize(iNumberOfRows, lNumberOfColumns).copy
rCostDataT.PasteSpecial Transpose:=True
Application.CutCopyMode = False

Range("by:cb,cg:cg").Delete

' top left justify all data cells

With Sheets("extract").Range("4:1000")
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
End With

' copy extract to a new sheet

Sheets("Extract").Select
Application.CutCopyMode = False
Sheets("Extract").Move

' save new sheet with a specified name

Application.EnableEvents = False
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs sMyPath & Format(Date, "yymmdd") & " Risk & Issue
Register Extract.xls"
Application.EnableEvents = True
Application.DisplayAlerts = True

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

End Sub

Thanks

Dave

"Simon Lloyd" wrote:


Risky Dave;363941 Wrote:
Hi,

I have a (quite complex) workbook with a considerable amount of

code
behind
it.

One macro copies the content of various sheets in the workbook to

a new
temporary sheet moves that sheet to a new workbook, renames the

new
workbook
and deletes the temporary sheet in the source workbook.

When this macro (called "Extract") runs, the path to all other

macros
in the
source workbook are being pointed at the newly created workbook

meaning
that
I need to go into the Macros properties in XL and reset tham back

to
the
original workbook. Given that there is some 40-odd macros in the

book,
this
is completely impractical (it's also impossible for me to ask my

users
to do
this every time they run Extract).

Having played with the code, the following are the lines that are
re-directing the macros:

' copy extract to a new sheet

Sheets("Extract").Select ' this is the temp sheet in the source
workbook
Application.CutCopyMode = False
Sheets("Extract").Move

Can someone please explain why this has started to happen (I have

been
using
this code for a couple of months without any problems - it has

only
started
to happen in the last week) and - more importantly - how do I fix

it?

TIA

Dave
Dave can you supply the workbook?, it may be that you have copied

the
workbook and are using that in TOOLSMACROMACROS you see a textbox
entitled "Macro's in" if this says All open workbooks or This

Workbook
then that may be the possible cause, it should show e.g example,xls


--
Simon Lloyd

Regards,
Simon Lloyd
'The Code Cage' ('The Code Cage - Microsoft Office Help - Microsoft

Office Discussion' (http://www.thecodecage.com))

------------------------------------------------------------------------
Simon Lloyd's Profile: 'The Code Cage Forums - View Profile: Simon

Lloyd' (http://www.thecodecage.com/forumz/member.php?userid=1)
View this thread: 'path to macros being changed - The Code Cage

Forums' (http://www.thecodecage.com/forumz/sh...d.php?t=102015)




--
Simon Lloyd

Regards,
Simon Lloyd
'The Code Cage' (http://www.thecodecage.com)
------------------------------------------------------------------------
Simon Lloyd's Profile: http://www.thecodecage.com/forumz/member.php?userid=1
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=102015