macro for multiple worksheets

[Guest]

Is there a way to have a macro span multiple worksheets but not the whole
workbook (i.e wks1,wks3,wks5 only)?

Also, is there a way to determine whether multiple worksheets have been
selected and activated?

 

[JE McGimpsey]

Number of worksheets selected (only one can be active at a time):


Dim nSelectedWS As Long
nSelectedWS = ActiveWindow.SelectedSheets.Count

for multiple worksheets:

Dim ws As Worksheet
For Each ws In Worksheets(Array("wks1", "wks3", "wks5"))
'do something with each ws
Next ws

 

[Ron de Bruin]

You can run code for a few sheets like this without selecting them

For Each sh In Sheets(Array("Sheet1", "Sheet3"))
sh.range("A1").value = "Hi"
next sh

Or use

For each sh in ActiveWindow.SelectedSheets

You can count the selected sheets like this
MsgBox ActiveWindow.SelectedSheets.Count

 

[Guest]

Brian,

I'm not entirely sure what you're asking. If you're talking about multiple
worksheets responding to events, say a change event, then I don't think so.
I think you'd have to put that code in each of the sheets.

On the other hand if you're talking about a more general macro that does
something to a value on a sheet, then this shouldn't be a problem. But I'd
need a little more info as to what you're trying to accomplish.

On your 2nd question, yes you can find the list of worksheets that have been
selected through a mulitple select. That would be if you ctrl-clicked a
bunch of them. Use the ActiveWindow.SelectedSheets property. You can find
out how many with ActiveWindow.SelectedSheets, and get a specific one with
ActiveWindow.SelectedSheets(2) for example.

 

[Don Guillett]

Usually, NO need to activate

Sub doworksheets()
myarray = Array(1, 3, 7)
For Each c In myarray
MsgBox Sheets("sheet" & c).Range("a1")
Next
End Sub

 

[Gord Dibben]

JE

On this topic of Worksheets(Array

What is the syntax for an Array of sheets not by hard-coded name but by
codename?

I know Worksheets(Array(1, 2, 4, 7) allows for renaming the sheets but if the
sheets get re-ordered, the 1,2,4,7 is out of whack.


Gord

 

[Guest]

Thanks, this looks like what I am looking for except these worksheets are
protected and must be unprotected to run the macro, then protected again at
the conclusion of the macro.
ActiveSheet.Unprotect pops up an error as does SelectedSheets.Unprotect

 

[Don Guillett]

ws.unprotect
ws. do something else

Depending on what you are doing, it probably is NOT necessary to select

 

[Dave Peterson]

I'd look for the codenames and then build an array names based on the codename.

(Saved from a previous post)

Option Explicit
Sub testme02()

Dim myCodeNames As Variant
Dim iCtr As Long
Dim mySheetNames() As String
Dim mySht As Object
Dim res As Variant

With ActiveWorkbook

myCodeNames = Array("Sheet1", "sheet3", "Sheet5")
ReDim mySheetNames(1 To .Sheets.Count)

iCtr = 0
For Each mySht In .Sheets
res = Application.Match(mySht.CodeName, myCodeNames, 0)
If IsError(res) Then
'no match, the board goes back
Else
iCtr = iCtr + 1
mySheetNames(iCtr) = mySht.Name
End If
Next mySht

If iCtr = 0 Then
MsgBox "no sheets to copy!"
Else
If UBound(myCodeNames) - LBound(myCodeNames) + 1 < iCtr Then
MsgBox "Not all sheets found"
Else
ReDim Preserve mySheetNames(1 To iCtr)
.Sheets(mySheetNames).Copy 'to a new workbook?
End If
End If
End With

End Sub

 

[Dave Peterson]

I'd look for the codenames and then build an array of sheet names based on the
codename.

(Stupid fingers/brain!)

 

[Gord Dibben]

Thanks for the response Dave.

I'll mull it over.

Gord

 

[JE McGimpsey]

Just an alternative:

Public Sub test3()
Dim colWS As Collection
Dim vCodeNames As Variant
Dim vCopyNames As Variant
Dim i As Long
Dim n As Long

vCodeNames = Array("Sheet1", "Sheet3", "Sheet5")
Set colWS = New Collection
With ActiveWorkbook
On Error Resume Next
For i = LBound(vCodeNames) To UBound(vCodeNames)
colWS.Add .VBProject.vbComponents( _
vCodeNames(i)).Properties("Name")
Next i
On Error GoTo 0
n = colWS.Count
If n > 0 Then
ReDim vCopyNames(1 To n)
For i = 1 To n
vCopyNames(i) = colWS(i)
Next i
.Sheets(vCopyNames).Copy 'to a new workbook
End If
End With
End Sub

Or, if you're SURE the codenamed sheets will be present:

Public Sub test4()
Dim vCodeNames As Variant
Dim vCopyNames As Variant
Dim nLow As Long
Dim nHi As Long
Dim i As Long

vCodeNames = Array("Sheet1", "Sheet3", "Sheet5")
nLow = LBound(vCodeNames)
nHi = UBound(vCodeNames)
ReDim vCopyNames(nLow To nHi)
With ActiveWorkbook
With .VBProject.vbComponents
For i = nLow To nHi
vCopyNames(i) = _
.Item(vCodeNames(i)).Properties("Name")
Next i
End With
.Sheets(vCopyNames).Copy 'to a new workbook
End With
End Sub

 

[Dave Peterson]

Just a warning with this technique...

If the user is using xl2002+
and has Tools|Macro|Security|trusted publishers tab
And has "trust access to Visual Basic Project" unchecked

Then this will fail. The error is ignored, but that collection won't have
anything added to it.