S
Simon Lloyd
Hi all,
I have a workbook with some 21 sheets, i have recently added a shee
and copied the code over for it (this part of the vba works fine!
however the code that is in the This workbook module does not seem t
work for this worksheet, i swapped this sheets position with the las
one still no joy and now that i have switched them back the sheet
swapped it with now has the same problem i cant see a fault in m
code......here is the code for the sheet and this workbook module.
Can you help??
Simon
Here's the code
Option Explicit
Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVa
Target As Range)
Dim valstr
Dim fValid As Boolean
Dim valint As Integer
On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, sh.Range("Skills" & sh.Index)) Is Nothin
Then
valstr = InputBox("Enter Skill Level" & vbCrLf & _
Space(5) & "1 = In Training" & vbCrLf & _
Space(5) & "2 = Trained" & vbCrLf & _
Space(5) & "3 = Can Train Others" & vbCrL
& _
Space(5) & "4 = Delete Colour and Entry"
_
"Skills Breakdown and Competencies Entry"
"")
valint = Val(valstr)
If valint = 0 Then
Application.EnableEvents = True
sh.Protect
Exit Sub
End If
With Target
sh.Unprotect
Select Case valint
Case 1: .Interior.ColorIndex = 48
Case 2: .Interior.ColorIndex = 33
Case 3: .Interior.ColorIndex = 6
Case 4: .Interior.ColorIndex = xlNone
.Value = ""
Case Else: MsgBox "Invalid Entry Try Again!"
End Select
If valint = 4 Then
With Target
sh.Cells(.Row, .Column + kTestColOff).Value = ""
End With
Else
CheckCondition Target, sh
End If
'sh.Range("A" & .Row).Select
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
Private Sub CheckCondition(ByVal Target As Range, ByVal sh As Object)
Dim rngtest As Range
With Target
Set rngtest = sh.Cells(.Row, .Column + kTestColOff)
If rngtest = "" Then
.Font.ColorIndex = kColorTest1
.Value = "h"
End If
rngtest.Value = ""
End With
End Sub
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sh As Object
Dim myrange As Range
Dim ComboBox1
Dim I1 As Integer
Dim res As Variant
Dim arySheets
On Error Resume Next
With arySheets
Set myrange = Range("E3:H641")
If Not Intersect(myrange, Target) Is Nothing Then
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
arySheets = Array("FSP's", "Quality & Others", "Alpha Process"
"Bulk & H&I", _
"Corn Process", "33 Bldg Packing", "Ctd Cor
Packing", _
"2 & 3 Coating", "Crispix", "Feed&Lab"
"Flavour", _
"Jet Zones", "Alpha Packing", "MPD", "Plan
Awareness", _
"Rice Cooking", "Vehicle Drivers (plant)"
"VIP", _
"15-21 & 22", "4&5 Coating", "Tank Floor 15
33 Bldg")
Sheets(arySheets).Select
For Each sh In ActiveWorkbook.Worksheets
sh.Unprotect
Next
End If
If ActiveCell.Column >= 5 And ActiveCell.Column <= 8 An
ActiveCell.Row >= 3 And ActiveCell.Row <= 641 Then
UserForm1.Show
If Not IsError(res) Then
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Worksheets("hidden").Visible = False
Me.Select
End If
If ActiveCell <> "shift " Then
Range("A" & ActiveCell.Row).Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
End If
End If
End With
End Su
I have a workbook with some 21 sheets, i have recently added a shee
and copied the code over for it (this part of the vba works fine!
however the code that is in the This workbook module does not seem t
work for this worksheet, i swapped this sheets position with the las
one still no joy and now that i have switched them back the sheet
swapped it with now has the same problem i cant see a fault in m
code......here is the code for the sheet and this workbook module.
Can you help??
Simon
Here's the code
Option Explicit
Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVa
Target As Range)
Dim valstr
Dim fValid As Boolean
Dim valint As Integer
On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, sh.Range("Skills" & sh.Index)) Is Nothin
Then
valstr = InputBox("Enter Skill Level" & vbCrLf & _
Space(5) & "1 = In Training" & vbCrLf & _
Space(5) & "2 = Trained" & vbCrLf & _
Space(5) & "3 = Can Train Others" & vbCrL
& _
Space(5) & "4 = Delete Colour and Entry"
_
"Skills Breakdown and Competencies Entry"
"")
valint = Val(valstr)
If valint = 0 Then
Application.EnableEvents = True
sh.Protect
Exit Sub
End If
With Target
sh.Unprotect
Select Case valint
Case 1: .Interior.ColorIndex = 48
Case 2: .Interior.ColorIndex = 33
Case 3: .Interior.ColorIndex = 6
Case 4: .Interior.ColorIndex = xlNone
.Value = ""
Case Else: MsgBox "Invalid Entry Try Again!"
End Select
If valint = 4 Then
With Target
sh.Cells(.Row, .Column + kTestColOff).Value = ""
End With
Else
CheckCondition Target, sh
End If
'sh.Range("A" & .Row).Select
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
Private Sub CheckCondition(ByVal Target As Range, ByVal sh As Object)
Dim rngtest As Range
With Target
Set rngtest = sh.Cells(.Row, .Column + kTestColOff)
If rngtest = "" Then
.Font.ColorIndex = kColorTest1
.Value = "h"
End If
rngtest.Value = ""
End With
End Sub
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sh As Object
Dim myrange As Range
Dim ComboBox1
Dim I1 As Integer
Dim res As Variant
Dim arySheets
On Error Resume Next
With arySheets
Set myrange = Range("E3:H641")
If Not Intersect(myrange, Target) Is Nothing Then
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
arySheets = Array("FSP's", "Quality & Others", "Alpha Process"
"Bulk & H&I", _
"Corn Process", "33 Bldg Packing", "Ctd Cor
Packing", _
"2 & 3 Coating", "Crispix", "Feed&Lab"
"Flavour", _
"Jet Zones", "Alpha Packing", "MPD", "Plan
Awareness", _
"Rice Cooking", "Vehicle Drivers (plant)"
"VIP", _
"15-21 & 22", "4&5 Coating", "Tank Floor 15
33 Bldg")
Sheets(arySheets).Select
For Each sh In ActiveWorkbook.Worksheets
sh.Unprotect
Next
End If
If ActiveCell.Column >= 5 And ActiveCell.Column <= 8 An
ActiveCell.Row >= 3 And ActiveCell.Row <= 641 Then
UserForm1.Show
If Not IsError(res) Then
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Worksheets("hidden").Visible = False
Me.Select
End If
If ActiveCell <> "shift " Then
Range("A" & ActiveCell.Row).Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
End If
End If
End With
End Su