Worksheet_Activate - conditional use

N

Neil

Hi All,

I have utilised the Worksheets Index macro from ozgrid.com as follows:

Private Sub Worksheet_Activate()
Dim wSheet As Worksheet
Dim l As Long
l = 1

With Me
.Columns(1).ClearContents
.Cells(1, 1) = "INDEX"
.Cells(1, 1).Name = "Index"
End With

For Each wSheet In Worksheets
If wSheet.Name <> Me.Name Then
l = l + 1
With wSheet
.Range("A1").Name = "Start " & wSheet.Index
.Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
SubAddress:="Index", TextToDisplay:="Back to Index"
End With

Me.Hyperlinks.Add Anchor:=Me.Cells(l, 1), Address:="", _
SubAddress:="Start " & wSheet.Index, TextToDisplay:=wSheet.Name
End If
Next wSheet
End SubThis is a great macro that auto updates and builds a TOC every time I open (activate) the "Index" sheet.Unfortunately I'd like to also be able to run another macro (manually, press 'button') from within this worksheet.The macro cycles through the available worksheets in the workbook and copies across data, thus creating a summary of key fields in my worksheets, as follows:Sub Transfer_Index_Summary()'' Transfer_Index_Summary Macro' Macro recorded 3/07/2007 by Neil'Application.ScreenUpdating = Falsetotalsheets = Worksheets.CountRange("b5:f16").ClearContentssheetcountno = 4rowno = 4'DoIf sheetcountno = totalsheets ThenExit SubElsesheetcountno = sheetcountno + 1rowno = rowno + 1 Sheets(sheetcountno).Select Cells(27, 2).Select Selection.Copy Sheets("Index").Select Cells(1, 2).Value = rowno Cells(2, 2).Value = sheetcountno Cells(rowno, 2).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets(sheetcountno).Select Cells(2, 15).Select Application.CutCopyMode = False Selection.Copy Sheets("Index").Select Cells(rowno, 3).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets(sheetcountno).Select Cells(2, 5).Select Application.CutCopyMode = False Selection.Copy Sheets("Index").Select Cells(rowno, 4).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets(sheetcountno).Select Cells(3, 5).Select Application.CutCopyMode = False Selection.Copy Sheets("Index").Select Cells(rowno, 5).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets(sheetcountno).Select Cells(3, 15).Select Application.CutCopyMode = False Selection.Copy Sheets("Index").Select Cells(rowno, 6).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If Loop'Application.EnableEvents = True End SubNow here's the problem, as soon as my manual code is run and gets to the line Sheets("Index").Selectit runs the Worksheet_Activate code and hence the (manual) code crashes when it can't paste the data to the sheet.Is there some way I can either combine these two macros (more elegantly hopefully) or otherwise halt the running of the auto macro until I have successfully run the manual macro ?Your help ( as always) is greatly appreciated.Regards,Neil
 
J

JE McGimpsey

While I won't bother to try to decipher all of your manual sub, since it
was pasted with no linefeeds, the solution is not to Select/Activate
worksheets at all in that sub. Deal directly with the range references -
it's faster, and smaller code, and IMO, easier to maintain.

Perhaps something like:

Dim ws As Worksheet
Dim rDest As Range

Set rDest = Sheets("Index").Cells(5, 2)
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "Index" Then
rDest.Value = ws.Cells(27, 2).Value
rDest.Offset(0, 1).Value = ws.Cells(2, 15).Value
Set rDest = rDest.Offset(1, 0)
End If
Next ws
 
B

Bob Phillips

Try this

Sub Transfer_Index_Summary()

Application.ScreenUpdating = False
totalsheets = Worksheets.Count
Range("b5:f16").ClearContents
sheetcountno = 4
rowno = 4
'
If sheetcountno = totalsheets Then Exit Sub

sheetcountno = sheetcountno + 1
rowno = rowno + 1

With Sheets("Index")
.Cells(1, 2).Value = rowno
.Cells(2, 2).Value = sheetcounto
.Cells(rowno, 2).Value = Sheets(sheetcountno).Cells(27, 2)
.Cells(rowno, 3).Value = Sheets(sheetcountno).Cells(2, 15)
.Cells(rowno, 4).Value = Sheets(sheetcountno).Cells(2, 5)
.Cells(rowno, 5).Value = Sheets(sheetcountno).Cells(3, 5)
.Cells(rowno, 6) = Sheets(sheetcountno).Cells(3, 15)
End With

Application.ScreenUpdating = True

End Sub


--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)



Hi All,

I have utilised the Worksheets Index macro from ozgrid.com as follows:

Private Sub Worksheet_Activate()
Dim wSheet As Worksheet
Dim l As Long
l = 1

With Me
.Columns(1).ClearContents
.Cells(1, 1) = "INDEX"
.Cells(1, 1).Name = "Index"
End With

For Each wSheet In Worksheets
If wSheet.Name <> Me.Name Then
l = l + 1
With wSheet
.Range("A1").Name = "Start " & wSheet.Index
.Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
SubAddress:="Index", TextToDisplay:="Back to Index"
End With

Me.Hyperlinks.Add Anchor:=Me.Cells(l, 1), Address:="", _
SubAddress:="Start " & wSheet.Index, TextToDisplay:=wSheet.Name
End If
Next wSheet
End Sub This is a great macro that auto updates and builds a TOC every time I open (activate) the "Index" sheet.Unfortunately I'd like to also be able to run another macro (manually, press 'button') from within this worksheet.The macro cycles through the available worksheets in the workbook and copies across data, thus creating a summary of key fields in my worksheets, as follows: Sub Transfer_Index_Summary()'' Transfer_Index_Summary Macro' Macro recorded 3/07/2007 by Neil'Application.ScreenUpdating = Falsetotalsheets = Worksheets.CountRange("b5:f16").ClearContentssheetcountno = 4rowno = 4'DoIf sheetcountno = totalsheets ThenExit SubElsesheetcountno = sheetcountno + 1rowno = rowno + 1 Sheets(sheetcountno).Select Cells(27, 2).Select Selection.Copy Sheets("Index").Select Cells(1, 2).Value = rowno Cells(2, 2).Value = sheetcountno Cells(rowno, 2).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets(sheetcountno).Select Cells(2, 15).Select Application.CutCopyMode = False Selection.Copy Sheets("Index").Select Cells(rowno, 3).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets(sheetcountno).Select Cells(2, 5).Select Application.CutCopyMode = False Selection.Copy Sheets("Index").Select Cells(rowno, 4).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets(sheetcountno).Select Cells(3, 5).Select Application.CutCopyMode = False Selection.Copy Sheets("Index").Select Cells(rowno, 5).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets(sheetcountno).Select Cells(3, 15).Select Application.CutCopyMode = False Selection.Copy Sheets("Index").Select Cells(rowno, 6).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If Loop'Application.EnableEvents = True End Sub Now here's the problem, as soon as my manual code is run and gets to the line Sheets("Index").Selectit runs the Worksheet_Activate code and hence the (manual) code crashes when it can't paste the data to the sheet.Is there some way I can either combine these two macros (more elegantly hopefully) or otherwise halt the running of the auto macro until I have successfully run the manual macro ?Your help ( as always) is greatly appreciated.Regards,Neil
 
N

Neil

Thanks for the code example, it is exactly the elegant solution I am looking
for.

Apart from that, I'll take with me two other lessons:

~ Always post in plain text
~ Learn to 'Dim' my variables as good practice.

Regards,

Neil
 
N

Neil

Thanks Bob,

Again another elegant solution - the direct referencing of ranges is a good one to remember instead of copy / paste ops.

Cheers.

Neil
Try this

Sub Transfer_Index_Summary()

Application.ScreenUpdating = False
totalsheets = Worksheets.Count
Range("b5:f16").ClearContents
sheetcountno = 4
rowno = 4
'
If sheetcountno = totalsheets Then Exit Sub

sheetcountno = sheetcountno + 1
rowno = rowno + 1

With Sheets("Index")
.Cells(1, 2).Value = rowno
.Cells(2, 2).Value = sheetcounto
.Cells(rowno, 2).Value = Sheets(sheetcountno).Cells(27, 2)
.Cells(rowno, 3).Value = Sheets(sheetcountno).Cells(2, 15)
.Cells(rowno, 4).Value = Sheets(sheetcountno).Cells(2, 5)
.Cells(rowno, 5).Value = Sheets(sheetcountno).Cells(3, 5)
.Cells(rowno, 6) = Sheets(sheetcountno).Cells(3, 15)
End With

Application.ScreenUpdating = True

End Sub


--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)



Hi All,

I have utilised the Worksheets Index macro from ozgrid.com as follows:

Private Sub Worksheet_Activate()
Dim wSheet As Worksheet
Dim l As Long
l = 1

With Me
.Columns(1).ClearContents
.Cells(1, 1) = "INDEX"
.Cells(1, 1).Name = "Index"
End With

For Each wSheet In Worksheets
If wSheet.Name <> Me.Name Then
l = l + 1
With wSheet
.Range("A1").Name = "Start " & wSheet.Index
.Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
SubAddress:="Index", TextToDisplay:="Back to Index"
End With

Me.Hyperlinks.Add Anchor:=Me.Cells(l, 1), Address:="", _
SubAddress:="Start " & wSheet.Index, TextToDisplay:=wSheet.Name
End If
Next wSheet
End Sub This is a great macro that auto updates and builds a TOC every time I open (activate) the "Index" sheet.Unfortunately I'd like to also be able to run another macro (manually, press 'button') from within this worksheet.The macro cycles through the available worksheets in the workbook and copies across data, thus creating a summary of key fields in my worksheets, as follows: Sub Transfer_Index_Summary()'' Transfer_Index_Summary Macro' Macro recorded 3/07/2007 by Neil'Application.ScreenUpdating = Falsetotalsheets = Worksheets.CountRange("b5:f16").ClearContentssheetcountno = 4rowno = 4'DoIf sheetcountno = totalsheets ThenExit SubElsesheetcountno = sheetcountno + 1rowno = rowno + 1 Sheets(sheetcountno).Select Cells(27, 2).Select Selection.Copy Sheets("Index").Select Cells(1, 2).Value = rowno Cells(2, 2).Value = sheetcountno Cells(rowno, 2).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets(sheetcountno).Select Cells(2, 15).Select Application.CutCopyMode = False Selection.Copy Sheets("Index").Select Cells(rowno, 3).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets(sheetcountno).Select Cells(2, 5).Select Application.CutCopyMode = False Selection.Copy Sheets("Index").Select Cells(rowno, 4).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets(sheetcountno).Select Cells(3, 5).Select Application.CutCopyMode = False Selection.Copy Sheets("Index").Select Cells(rowno, 5).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets(sheetcountno).Select Cells(3, 15).Select Application.CutCopyMode = False Selection.Copy Sheets("Index").Select Cells(rowno, 6).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If Loop'Application.EnableEvents = True End Sub Now here's the problem, as soon as my manual code is run and gets to the line Sheets("Index").Selectit runs the Worksheet_Activate code and hence the (manual) code crashes when it can't paste the data to the sheet.Is there some way I can either combine these two macros (more elegantly hopefully) or otherwise halt the running of the auto macro until I have successfully run the manual macro ?Your help ( as always) is greatly appreciated.Regards,Neil
 
B

Bob Phillips

Hi Neil,

I see that JE gave a looping solution, but in a small dataset, a loop is unnecessary, and does mask the functionality somewhat, IMO.

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)



Thanks Bob,

Again another elegant solution - the direct referencing of ranges is a good one to remember instead of copy / paste ops.

Cheers.

Neil
Try this

Sub Transfer_Index_Summary()

Application.ScreenUpdating = False
totalsheets = Worksheets.Count
Range("b5:f16").ClearContents
sheetcountno = 4
rowno = 4
'
If sheetcountno = totalsheets Then Exit Sub

sheetcountno = sheetcountno + 1
rowno = rowno + 1

With Sheets("Index")
.Cells(1, 2).Value = rowno
.Cells(2, 2).Value = sheetcounto
.Cells(rowno, 2).Value = Sheets(sheetcountno).Cells(27, 2)
.Cells(rowno, 3).Value = Sheets(sheetcountno).Cells(2, 15)
.Cells(rowno, 4).Value = Sheets(sheetcountno).Cells(2, 5)
.Cells(rowno, 5).Value = Sheets(sheetcountno).Cells(3, 5)
.Cells(rowno, 6) = Sheets(sheetcountno).Cells(3, 15)
End With

Application.ScreenUpdating = True

End Sub


--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)



Hi All,

I have utilised the Worksheets Index macro from ozgrid.com as follows:

Private Sub Worksheet_Activate()
Dim wSheet As Worksheet
Dim l As Long
l = 1

With Me
.Columns(1).ClearContents
.Cells(1, 1) = "INDEX"
.Cells(1, 1).Name = "Index"
End With

For Each wSheet In Worksheets
If wSheet.Name <> Me.Name Then
l = l + 1
With wSheet
.Range("A1").Name = "Start " & wSheet.Index
.Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
SubAddress:="Index", TextToDisplay:="Back to Index"
End With

Me.Hyperlinks.Add Anchor:=Me.Cells(l, 1), Address:="", _
SubAddress:="Start " & wSheet.Index, TextToDisplay:=wSheet.Name
End If
Next wSheet
End Sub This is a great macro that auto updates and builds a TOC every time I open (activate) the "Index" sheet.Unfortunately I'd like to also be able to run another macro (manually, press 'button') from within this worksheet.The macro cycles through the available worksheets in the workbook and copies across data, thus creating a summary of key fields in my worksheets, as follows: Sub Transfer_Index_Summary()'' Transfer_Index_Summary Macro' Macro recorded 3/07/2007 by Neil'Application.ScreenUpdating = Falsetotalsheets = Worksheets.CountRange("b5:f16").ClearContentssheetcountno = 4rowno = 4'DoIf sheetcountno = totalsheets ThenExit SubElsesheetcountno = sheetcountno + 1rowno = rowno + 1 Sheets(sheetcountno).Select Cells(27, 2).Select Selection.Copy Sheets("Index").Select Cells(1, 2).Value = rowno Cells(2, 2).Value = sheetcountno Cells(rowno, 2).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets(sheetcountno).Select Cells(2, 15).Select Application.CutCopyMode = False Selection.Copy Sheets("Index").Select Cells(rowno, 3).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets(sheetcountno).Select Cells(2, 5).Select Application.CutCopyMode = False Selection.Copy Sheets("Index").Select Cells(rowno, 4).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets(sheetcountno).Select Cells(3, 5).Select Application.CutCopyMode = False Selection.Copy Sheets("Index").Select Cells(rowno, 5).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets(sheetcountno).Select Cells(3, 15).Select Application.CutCopyMode = False Selection.Copy Sheets("Index").Select Cells(rowno, 6).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If Loop'Application.EnableEvents = True End Sub Now here's the problem, as soon as my manual code is run and gets to the line Sheets("Index").Selectit runs the Worksheet_Activate code and hence the (manual) code crashes when it can't paste the data to the sheet.Is there some way I can either combine these two macros (more elegantly hopefully) or otherwise halt the running of the auto macro until I have successfully run the manual macro ?Your help ( as always) is greatly appreciated.Regards,Neil
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Run-time error 1004 paste method of worksheet class failed 3
conso macro 0
Copy Paste Macro not Pasting Values when Blank 3
= Today()+1 into Sheet1, Sheet2, and Sheet3 2
Run macro from active workbook whose name keeps changing 20
Simplify Code for Copy/Paste Special 11
Copy paste - Values - formula - Optimise 2
Code not working as expected 2

Top