|
running change events to macros
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 |
running change events to macros
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 On Nov 21, 10:57*am, Dave ferris <Dave wrote: 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 |
running change events to macros
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 "Susan" wrote: 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 On Nov 21, 10:57 am, Dave ferris <Dave wrote: 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 |
running change events to macros
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" wrote in message ... 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 "Susan" wrote: 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 On Nov 21, 10:57 am, Dave ferris <Dave wrote: 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 |
running change events to macros
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 "Bernie Deitrick" wrote: 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" wrote in message ... 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 "Susan" wrote: 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 On Nov 21, 10:57 am, Dave ferris <Dave wrote: 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 |
running change events to macros
Hi Dave
Change the line to: Cell.Interior.ColorIndex = VColour Regards, Per On 17 Dec., 22:59, Dave ferris wrote: 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 "Bernie Deitrick" wrote: 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" wrote in message ... 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 "Susan" wrote: 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 On Nov 21, 10:57 am, Dave ferris <Dave wrote: 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- Skjul tekst i anførselstegn - - Vis tekst i anførselstegn - |
running change events to macros
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" wrote: Hi Dave Change the line to: Cell.Interior.ColorIndex = VColour Regards, Per On 17 Dec., 22:59, Dave ferris wrote: 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 "Bernie Deitrick" wrote: 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" wrote in message ... 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 "Susan" wrote: 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 On Nov 21, 10:57 am, Dave ferris <Dave wrote: 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- Skjul tekst i anførselstegn - - Vis tekst i anførselstegn - |
running change events to macros
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 On 18 Dec., 03:51, Dave ferris wrote: 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" wrote: Hi Dave Change the line to: Cell.Interior.ColorIndex = VColour Regards, Per On 17 Dec., 22:59, Dave ferris wrote: 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 "Bernie Deitrick" wrote: 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" wrote in message ... 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 "Susan" wrote: 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 On Nov 21, 10:57 am, Dave ferris <Dave wrote: 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- Skjul tekst i anførselstegn - - Vis tekst i anførselstegn -- Skjul tekst i anførselstegn - - Vis tekst i anførselstegn - |
running change events to macros
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 "Per Jessen" wrote: 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 On 18 Dec., 03:51, Dave ferris wrote: 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" wrote: Hi Dave Change the line to: Cell.Interior.ColorIndex = VColour Regards, Per On 17 Dec., 22:59, Dave ferris wrote: 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 "Bernie Deitrick" wrote: 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" wrote in message ... 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 "Susan" wrote: 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 On Nov 21, 10:57 am, Dave ferris <Dave wrote: 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- Skjul tekst i anførselstegn - - Vis tekst i anførselstegn -- Skjul tekst i anførselstegn - - Vis tekst i anførselstegn - |
| All times are GMT +1. The time now is 10:01 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com