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!):
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' (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