F
Ferret via OfficeKB.com
hi everyone,
this is the last part of myproject thats eluding me i have tried several
variations/ combinations.the story so far. i have aworkbook with 3 worksheets
labelled MRoster, Depts 1&3, Depts 2&4.
the last 2 worksheets supply all the data to the MRoster by copying and
pasting each entry.
i have 3 peices of code which are event based and when run seperatley from
the worksheet work with no problems. what i am trying to do now is run these
in sequence. the sequence being : change the selected cell value to upper
case fromn lower - then colour fill the cell in relation to cell value - then
copy and paste the data on to the Mroster.
i have put the various code in seperate modules and changee the name to fit
the action it carries out calling the code from an event from the active
worksheet.the codes below are the ones i'm using the Sub ********* is what i
have named them in the modules but as you can see they are set up as per an
event. when i try to run the code from the modules i get a "Run Time
error'424' Object Required.
can some one please help me this is the final hurdle and i don't /can't find
what the problem is
many thanks
Ferret
this is in worksheet Depts1&3
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Call Lower_2_Upper
Call Colours_Mod
Call CandP1
Application.EnableEvents = True
End Sub
Module1
Private Sub Worksheet_2Change(ByVal Target As Range) ‘Sub
Lower_2_Upper’
If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub
On Error Resume Next
If Not Intersect(Target, Range("B:AQ")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End If
On Error GoTo 0
End Sub
Module2
Private Sub Worksheet_Change(ByVal Target As Range) ‘Sub
Colours_Mod’
Dim vLetter As String
Dim vColor As Long
Dim cRange As Range
Dim cell As Range
Set cRange = Intersect(Range("B:AQ"), Range(Target(1).Address))
If cRange Is Nothing Then Exit Sub
For Each cell In Target
vLetter = UCase(Left(cell.Value & " ", 1))
vColor = 0 'default is no color
Select Case vLetter
Case "L"
vColor = 34
Case "B"
vColor = 36
Case "C"
vColor = 39
Case "D"
vColor = 41
Case "E"
vColor = 38
Case "F"
vColor = 37
Case "G"
vColor = 35
End Select
Application.EnableEvents = False
cell.Interior.ColorIndex = vColor
Application.EnableEvents = True 'should
Next cell
'Target.Offset(0, 1).Interior.colorindex = vColor
End Sub
Module3
Private Sub Worksheet_Change(ByVal Target As Range) ‘Sub CandP’
For Dept = 1 To 3 Step 2
For MonthNum = 1 To 12
RangeName = MonthName(MonthNum, True) & "d" & Dept
If Not Intersect(Target, Range(RangeName)) Is Nothing Then
DestRangeName = Dept & "d" & MonthName(MonthNum, True)
Range(RangeName).Copy _
Destination:=Sheets("Master Roster").Range(DestRangeName)
Exit Sub
End If
Next MonthNum
Next Dept
End Sub
this is the last part of myproject thats eluding me i have tried several
variations/ combinations.the story so far. i have aworkbook with 3 worksheets
labelled MRoster, Depts 1&3, Depts 2&4.
the last 2 worksheets supply all the data to the MRoster by copying and
pasting each entry.
i have 3 peices of code which are event based and when run seperatley from
the worksheet work with no problems. what i am trying to do now is run these
in sequence. the sequence being : change the selected cell value to upper
case fromn lower - then colour fill the cell in relation to cell value - then
copy and paste the data on to the Mroster.
i have put the various code in seperate modules and changee the name to fit
the action it carries out calling the code from an event from the active
worksheet.the codes below are the ones i'm using the Sub ********* is what i
have named them in the modules but as you can see they are set up as per an
event. when i try to run the code from the modules i get a "Run Time
error'424' Object Required.
can some one please help me this is the final hurdle and i don't /can't find
what the problem is
many thanks
Ferret
this is in worksheet Depts1&3
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Call Lower_2_Upper
Call Colours_Mod
Call CandP1
Application.EnableEvents = True
End Sub
Module1
Private Sub Worksheet_2Change(ByVal Target As Range) ‘Sub
Lower_2_Upper’
If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub
On Error Resume Next
If Not Intersect(Target, Range("B:AQ")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End If
On Error GoTo 0
End Sub
Module2
Private Sub Worksheet_Change(ByVal Target As Range) ‘Sub
Colours_Mod’
Dim vLetter As String
Dim vColor As Long
Dim cRange As Range
Dim cell As Range
Set cRange = Intersect(Range("B:AQ"), Range(Target(1).Address))
If cRange Is Nothing Then Exit Sub
For Each cell In Target
vLetter = UCase(Left(cell.Value & " ", 1))
vColor = 0 'default is no color
Select Case vLetter
Case "L"
vColor = 34
Case "B"
vColor = 36
Case "C"
vColor = 39
Case "D"
vColor = 41
Case "E"
vColor = 38
Case "F"
vColor = 37
Case "G"
vColor = 35
End Select
Application.EnableEvents = False
cell.Interior.ColorIndex = vColor
Application.EnableEvents = True 'should
Next cell
'Target.Offset(0, 1).Interior.colorindex = vColor
End Sub
Module3
Private Sub Worksheet_Change(ByVal Target As Range) ‘Sub CandP’
For Dept = 1 To 3 Step 2
For MonthNum = 1 To 12
RangeName = MonthName(MonthNum, True) & "d" & Dept
If Not Intersect(Target, Range(RangeName)) Is Nothing Then
DestRangeName = Dept & "d" & MonthName(MonthNum, True)
Range(RangeName).Copy _
Destination:=Sheets("Master Roster").Range(DestRangeName)
Exit Sub
End If
Next MonthNum
Next Dept
End Sub