ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Bob Phillips (https://www.excelbanter.com/excel-programming/306233-re-bob-phillips.html)

Tom Ogilvy

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





All times are GMT +1. The time now is 10:35 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com