How do I solve this?
Bob,
It doesn't work.
There are no errors which is good, but something is wrong in the code
itself, if I enter a number from 1 to 12 in a sheet, the others do not
change.
Thanks
Alex
"Bob Phillips" wrote in message
...
Alex,
Re-order the coide
Option Explicit
Dim arySheets
Private Sub Workbook_Open()
'''Enable Outlining navigation and protect everything on the sheet with
UserInterfaceOnly.
Sheet2.EnableOutlining = True
Sheet2.Protect , True, True, True, True
Sheet8.EnableOutlining = True
Sheet8.Protect , True, True, True, True
Sheet9.EnableOutlining = True
Sheet9.Protect , True, True, True, True
Sheet10.EnableOutlining = True
Sheet10.Protect , True, True, True, True
Sheet11.EnableOutlining = True
Sheet11.Protect , True, True, True, True
Sheet12.EnableOutlining = True
Sheet12.Protect , True, True, True, True
Sheet13.EnableOutlining = True
Sheet13.Protect , True, True, True, True
Sheet15.EnableOutlining = True
Sheet15.Protect , True, True, True, True
Sheet16.EnableOutlining = True
Sheet16.Protect , True, True, True, True
Sheet17.EnableOutlining = True
Sheet17.Protect , True, True, True, True
Sheet18.EnableOutlining = True
Sheet18.Protect , True, True, True, True
Sheet19.EnableOutlining = True
Sheet19.Protect , True, True, True, True
Sheet20.EnableOutlining = True
Sheet20.Protect , True, True, True, True
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim oSheet As Worksheet
On Error GoTo ws_exit:
arySheets = Array("Sheet9", "Sheet10", "Sheet11", "Sheet12",
"Sheet13",
"Sheet15", "Sheet16", "Sheet17", "Sheet18", "Sheet20")
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
--
HTH
Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
"Metallo" wrote in message
...
Bob,
I get the following error message when I apply the change:
"Only comments may appear after EndSub, EndFunction or EndProperty"
Then I added a comment delimiter and the result is that I don't get the
error but the code doesn't change the numbers in the sheets I have
selected.
To make it easier, I enclose the two codes as they appear in the WB:
Private Sub Workbook_Open()
'''Enable Outlining navigation and protect everything on the sheet with
UserInterfaceOnly.
Sheet2.EnableOutlining = True
Sheet2.Protect , True, True, True, True
Sheet8.EnableOutlining = True
Sheet8.Protect , True, True, True, True
Sheet9.EnableOutlining = True
Sheet9.Protect , True, True, True, True
Sheet10.EnableOutlining = True
Sheet10.Protect , True, True, True, True
Sheet11.EnableOutlining = True
Sheet11.Protect , True, True, True, True
Sheet12.EnableOutlining = True
Sheet12.Protect , True, True, True, True
Sheet13.EnableOutlining = True
Sheet13.Protect , True, True, True, True
Sheet15.EnableOutlining = True
Sheet15.Protect , True, True, True, True
Sheet16.EnableOutlining = True
Sheet16.Protect , True, True, True, True
Sheet17.EnableOutlining = True
Sheet17.Protect , True, True, True, True
Sheet18.EnableOutlining = True
Sheet18.Protect , True, True, True, True
Sheet19.EnableOutlining = True
Sheet19.Protect , True, True, True, True
Sheet20.EnableOutlining = True
Sheet20.Protect , True, True, True, True
End Sub
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("Sheet9", "Sheet10", "Sheet11", "Sheet12",
"Sheet13", "Sheet15", "Sheet16", "Sheet17", "Sheet18", "Sheet20")
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
---------------
Thanks for your help
Alex
"Bob Phillips" wrote:
Hi Alex,
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
--
HTH
Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
"Metallo" wrote in message
...
Bob,
Thank you for your second option.
It works fine but I have one last issue to solve now:
I need to select a range of sheets to apply the code, as it is now
it
applies on all the sheets.
Would you please add, say, Sheet1, Sheet2 and Sheet3 so that I can
see
where
and how you do it and I will add the rest.
Thank you!
Alex
PS: Have you got any book to suggest me to learn the basics of
programming
on VBA?
"Bob Phillips" wrote in message
...
Metallo,
I never locks for me. With some sheets protected it can bomb out,
but
not
lock out.
Here is an amended version that checks for a value of 1-12, and
also
unlocks
the sheet before setting B5, and re-protecting.
See if this improves it
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target
As
Range)
Dim oSheet As Worksheet
On Error GoTo ws_exit:
Application.EnableEvents = False
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 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
ws_exit:
Application.EnableEvents = True
End Sub
--
HTH
Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
"Metallo" wrote in message
...
Bob,
Your solution works irregularly.
By this I mean that when I input the number (1 to 12, although
it
accepts
higher numbers, maybe you can tell me how to fix this so that it
only
accepts numbers till 12), sometimes it works and change them in
all
the
other WS, sometimes, instead it just blocks Excel and I have to
press
CTR+ALT+DEL.
This worries me because having to deliver the application to
other
users,
it can be a problem.
Is it possible a conflict with other codes and macro in the
application?
As I mentioned in my previous mail, I have the following code to
protect
the sheets and guarantee the outlining:
Private Sub Workbook_Open()
'''Enable Outlining navigation and protect everything on the
sheet
with
UserInterfaceOnly.
Sheet2.EnableOutlining = True
Sheet2.Protect , True, True, True, True
Sheet8.EnableOutlining = True
Sheet8.Protect , True, True, True, True
Sheet9.EnableOutlining = True
Sheet9.Protect , True, True, True, True
Sheet10.EnableOutlining = True
Sheet10.Protect , True, True, True, True
Sheet11.EnableOutlining = True
Sheet11.Protect , True, True, True, True
Sheet12.EnableOutlining = True
Sheet12.Protect , True, True, True, True
Sheet13.EnableOutlining = True
Sheet13.Protect , True, True, True, True
Sheet15.EnableOutlining = True
Sheet15.Protect , True, True, True, True
Sheet16.EnableOutlining = True
Sheet16.Protect , True, True, True, True
Sheet17.EnableOutlining = True
Sheet17.Protect , True, True, True, True
Sheet18.EnableOutlining = True
Sheet18.Protect , True, True, True, True
Sheet19.EnableOutlining = True
Sheet19.Protect , True, True, True, True
Sheet20.EnableOutlining = True
Sheet20.Protect , True, True, True, True
End Sub
This is instead the one you gave me with the cell changed to B5
because
is
the one to input the number.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal
Target
As
Range)
Dim oSheet As Worksheet
On Error GoTo ws_exit:
Application.EnableEvents = False
If Target.Address = "$B$5" Then
For Each oSheet In ActiveWorkbook.Worksheets
If oSheet.Name < Sh.Name Then
oSheet.Range("B5").Value = Sh.Range("B5").Value
End If
Next oSheet
End If
ws_exit:
Application.EnableEvents = True
End Sub
Hope you can help
Alex
"Bob Phillips" wrote:
This line
osheet.Range("A1").Value =
Sh.rnage("A1").Value
shouyld read
osheet.Range("A1").Value =
Sh.Range("A1").Value
--
HTH
Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
"Bob Phillips" wrote in
message
...
Alex,
Try this
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal
Target
As
Range)
dim oSheet as worksheet
On Error GoTo ws_exit:
Application.EnableEvents = False
If Target.Address = "$A$1" Then
For Each osheet In ActiveWorkbook.Worksheets
If osheet.Name < Sh.Name Then
osheet.Range("A1").Value =
Sh.rnage("A1").Value
End If
Next osheet
End If
ws_exit:
Application.EnableEvents = True
End Sub
Put the coide in ThisWorkbook code module.
--
HTH
Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
"Metallo" wrote in
message
...
Jim,
What you say is true, however, it doens't solve the
problem.
If I link all WS (2 to 10) to WS1 the change will only
occur
if
I
change
the month in WS1.
What I want to get, is to have a change regardless of the
WS
you
input
the
number.
For instance, I input the month number in WS3, all the
others
will
also
switch to the same number.If I input the number in WS4,
again
all
the
other
will change, and so on.
I hope this is now clearer.
Thank you
Alex
"Jim Rech" wrote:
Formulas can refer to cells on other worksheets. Enter
a
formula
like
=WS1!A1 in the appropriate cell on each worksheet.
--
Jim Rech
Excel MVP
"Metallo" wrote in
message
...
| Hi,
|
| I've got a WB that includes 10 WS (1 to 10), they all
have
the
same
format.
| In every WS, there is the possibility to enter a
numeric
reference
to
a
month and get the corresponding YTD results. For
instance,
if
I
want
to
see
the April YTD, I input 4 and all the numbers change
accordingly.
|
| My question: How can I link the 10 WS in a way that
when
I
input
"4"
in
say, WS1 all the other WS (2 to 10) change also to 4?
| This is necessary in order to get data consistency.
|
| Thank you
| Alex
|
|