running change events to macros

[Dave ferris]

hi i'm new to vba and i'm struggling with this problem.
i have 2 event programs which i wish to convert to macros so i can use an
event procedure to run these macros along with 2 others in order below is the
code for the event programs i wish to change.

the first one changes all lower case to upper case

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then
Exit Sub
End If
On Error GoTo ErrHandler:
If Not Application.Intersect(Me.Range("C5:AG13"), Target) Is Nothing Then
If IsNumeric(Target.Value) = False Then
Application.EnableEvents = False
'Target.Value = StrConv(Target.Text, vbLowerCase)
Target.Value = StrConv(Target.Text, vbUpperCase)
'Target.Value = StrConv(Target.Text, vbProperCase)
Application.EnableEvents = True
End If
End If
ErrHandler:
Application.EnableEvents = True
End Sub

this one copies a named range when a change is initiated then copies it to a
master worksheet with a similar named range.

Sub worksheet_change(ByVal target As Range)

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

the other 2 macros are for changing the cell interior colours when a set
condition is met.

your help in this problem is very much appreciated
thank you

 

[Susan]

as i'm sure you've discovered, you can only have one worksheet_change
macro. I'd suggest this........
put the individual programs in modules and name them something
different. then call them individually from the worksheet_change
macro.
like this:

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents=False

Call Lower_2_Upper
Call Month_Name

Application.EnableEvents = True

End Sub


Sub Lower_2_Upper()

If Target.Cells.Count > 1 Then
Exit Sub
End If
On Error GoTo ErrHandler:
If Not Application.Intersect(Me.Range("C5:AG13"), Target) Is
Nothing Then
If IsNumeric(Target.Value) = False Then
' Application.EnableEvents = False
'Target.Value = StrConv(Target.Text, vbLowerCase)
Target.Value = StrConv(Target.Text, vbUpperCase)
'Target.Value = StrConv(Target.Text, vbProperCase)
' Application.EnableEvents = True
End If
End If
ErrHandler:
Application.EnableEvents = True

End Sub


Sub Month_Name()

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


hope that helps!

susan

 

[Dave ferris]

hi susan,
many thanks for the quick reply sorry i have'nt replied earlier but been
shoved else where at work. i've tried the changes as you sugested but i get a
run time error "424" object required.
when i run the debug F8 it highlights the line with the word "target" in it.
any sugestions on how to remedy this?

many thanks

Dave

 

[Bernie Deitrick]

Dave,

You need to pass the range to the subs:

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
Lower_2_Upper Target
Month_Name Target
Application.EnableEvents = True

End Sub


Sub Lower_2_Upper(Target As Range)

If Target.Cells.Count > 1 Then
Exit Sub
End If
On Error GoTo ErrHandler:
If Not Application.Intersect(Me.Range("C5:AG13"), Target) Is Nothing Then
If IsNumeric(Target.Value) = False Then
' Application.EnableEvents = False
'Target.Value = StrConv(Target.Text, vbLowerCase)
Target.Value = StrConv(Target.Text, vbUpperCase)
'Target.Value = StrConv(Target.Text, vbProperCase)
' Application.EnableEvents = True
End If
End If
Exit Sub
ErrHandler:
Application.EnableEvents = True

End Sub


Sub Month_Name(Target As Range)

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

HTH,
Bernie
MS Excel MVP

 

[Dave ferris]

hi Bernie,
the only thing i would never of thought of, so many thanks the solution was
smack on the nose.
just one other little problem it's with another peice of code that colours
the target cell according to the value entered the code is below:

Sub ApplyFormats(Target As Range)
Dim VLetter As String
Dim VColour As Long
Dim CRange As Range
Dim Cell As Range

Set CRange = Intersect(Range("B:AQ"), Range(Target.Address))
If CRange Is Nothing Then Exit Sub
For Each Cell In Target

VColour = 0
Select Case VLetter
Case "L"
VColour = 4
Case "SD"
VColour = 34
Case "G"
VColour = 43
Case "C"
VColour = 39
Case "CT"
VColour = 47
Case "S"
VColour = 40
Case "D1"
VColour = 45
Case "D2"
VColour = 45
Case "D3"
VColour = 45
Case "D4"
VColour = 45
Case "N1"
VColour = 46
Case "N2"
VColour = 46
Case "N3"
VColour = 46
Case "N4"
VColour = 46
Case "SN"
VColour = 50
End Select
Application.EnableEvents = False
Cell.Interior.ColourIndex = VColour '*'
Application.EnableEvents = True
Next Cell
End Sub

when i run the code i get a run time error '438'
object does not support this property or method.

when i debug it highlights the line i have marked '*'
i have tried changing the cell to different names and declaring them but
they all fail.
i know it's cheeky of me to ask since you have already solved my main dilema.

many thanks
Dave F

 

[Per Jessen]

Hi Dave

Change the line to:

Cell.Interior.ColorIndex = VColour

Regards,
Per

 

[Dave ferris]

hi Per Jessen,
many thanks for the quick reply, i did the change as per your advice i don't
get an error but when i run the code by entering a value the code completes
it's cycle but there is no colour change.
any suggestions?

Dave F

 

[Per Jessen]

Hi Dave F

The vLetter variable never gets any value. I think this may do it:

.....
Set CRange = Intersect(Range("B:AQ"), Target)
If CRange Is Nothing Then Exit Sub
For Each Cell In Target
VLetter = Target.Value
.....


BTW:You might want to use For Each Cell In CRange, which is the range
that intesect if you only need to loop through cells which intersect.

Regards,
Per

 

[Dave ferris]

i must appologise for my late reply, the code works with out doing any of the
previous changes you did for me,for what ever reason it works. it was
probably a cliche with my computer. the project can at last rest in peace.
many thanks for the advice and help you have all given me.
i have learnt alot again many thanks

dave f