Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 27,285
Default Bob Phillips

If I understood your description, this worked for me: Specify your two
additional sheets in both arySheets (add to current list) and arySheets1
(only the two added sheets). I have also redefined the arguments to the
function, so you need to replace all you code. Of course do this on a copy
of the workbook until you are satisfied this does what you need.

Option Explicit



Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim oSheet As Worksheet
Dim ArySheets
Dim arySheets1
Dim bAdded As Boolean
On Error GoTo ws_exit:
ArySheets = Array("Sheet1", "Sheet3", "Added1", "Added2")
arySheets1 = Array("Added1", "Added2")
Application.EnableEvents = False
bAdded = SheetInArray(Sh.Name, arySheets1)
If SheetInArray(Sh.Name, ArySheets) Then
If (Not bAdded) * (Target.Address = "$B$5") Or _
bAdded * (Target.Address = "$A$1") Then
With Target
If .Value = 1 And .Value <= 12 Then
For Each oSheet In ActiveWorkbook.Worksheets
If oSheet.Name < Sh.Name And _
SheetInArray(oSheet.Name, ArySheets) Then
If oSheet.ProtectContents Then
oSheet.Unprotect
If SheetInArray(oSheet.Name, arySheets1) Then
oSheet.Range("A1").Value = .Value
Else
oSheet.Range("B5").Value = .Value
End If
oSheet.Protect
Else
If SheetInArray(oSheet.Name, arySheets1) Then
oSheet.Range("A1").Value = .Value
Else
oSheet.Range("B5").Value = .Value
End If
End If
End If
Next oSheet
Else
MsgBox .Value & " is an invalid value"
.Value = ""
End If
End With
End If
End If

ws_exit:
Application.EnableEvents = True

End Sub

Private Function SheetInArray(Name As String, ArySheets)
Dim fSheet As Boolean
Dim i As Long
fSheet = False
For i = LBound(ArySheets, 1) To UBound(ArySheets, 1)
If LCase(ArySheets(i)) = LCase(Name) Then
fSheet = True
Exit For
End If
Next i
SheetInArray = fSheet
End Function



--
Regards,
Tom Ogilvy

"Metallo" wrote in message
...
Hi Bob,

Some time ago, you provided me with this code that allows to enter in 10
different sheets, in a given cell (B5), a number representing a calendar
month. This will trigger a calculation that will be the same for all the

10
sheets contemporaneously.
The calculation can be triggered starting from any of the sheets.

Here's the code:


Option Explicit

Dim arySheets

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As

Range)
Dim oSheet As Worksheet

On Error GoTo ws_exit:
arySheets = Array("Sheet1", "Sheet3")
Application.EnableEvents = False
If SheetInArray(Sh.Name) Then
If Target.Address = "$B$5" Then
With Target
If .Value = 1 And .Value <= 12 Then
For Each oSheet In ActiveWorkbook.Worksheets
If oSheet.Name < Sh.Name And
SheetInArray(oSheet.Name) Then
If oSheet.ProtectContents Then
oSheet.Unprotect
oSheet.Range("B5").Value = .Value
oSheet.Protect
Else
oSheet.Range("B5").Value = .Value
End If
End If
Next oSheet
Else
MsgBox .Value & " is an invalid value"
.Value = ""
End If
End With
End If
End If

ws_exit:
Application.EnableEvents = True

End Sub

Private Function SheetInArray(Name As String)
Dim fSheet As Boolean
Dim i As Long
fSheet = False
For i = LBound(arySheets, 1) To UBound(arySheets, 1)
If arySheets(i) = Name Then
fSheet = True
Exit For
End If
Next i
SheetInArray = fSheet
End Function

Now, I need to add the same function to two additional sheets, in itself

is
not an issue, but my problem is that for these two sheets, the cell is
different, it must be A1. The calculation has to be the same as per the

other
10 sheets.
Basically, I should be able to select the month in A1 and have the same
calculation I'm having today, the only difference is that it happens also
into the two new sheets and that only into these two news sheets the 1-12
(Month) has to be entered in cell A1.

Thank you for your help.

Alex



Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
to Bob Phillips Jack Sons Excel Discussion (Misc queries) 15 August 28th 07 02:51 PM
For Bob Phillips D.J.Shaw Excel Worksheet Functions 5 August 3rd 05 01:20 AM
Bob phillips?? gav meredith[_2_] Excel Programming 1 April 20th 04 01:41 PM
Bob Phillips Mickey[_3_] Excel Programming 1 March 5th 04 08:46 PM
Bob Phillips boblauder[_2_] Excel Programming 2 January 21st 04 03:28 PM


All times are GMT +1. The time now is 09:28 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"