Adding code to existing worksheet change event

I

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,832
Office Version
  1. 2007
Platform
  1. Windows
Morning,
I seem to be doing this more often lately but dont get the correct idea of doing it.
Can you advise a rule of thumb please.


I have this existing code.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)Dim r   As Range
    
    On Error GoTo errHandle 'if we encounter an error, handle it
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
        If Target.Address = "$A$6" Then
            With Sheets("INFO").Range("CG2")
                If Len(.Offset(1).Value) Then
                    Set r = .End(xlDown).Offset(1)
                    With .End(xlDown).Offset(1)
                        .Value = UCase$(ActiveSheet.Cells(6, 1).Value)
                        .Interior.ColorIndex = 6
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlBottom
                        .VerticalAlignment = xlCenter
                        .Borders.LineStyle = xlContinuous
                        .RowHeight = 19.5
                        .Font.Bold = True
                        With ActiveWorkbook.Worksheets("INFO").Sort
                             .SetRange Range("CG2:CG500")
                             .Header = xlYes
                             .MatchCase = False
                             .Orientation = xlTopToBottom
                             .SortMethod = xlPinYin
                             .Apply
                        End With
                    End With
                End If
             End With
        End If
        
    With Target
        If .Column <> 13 And .Count = 1 And Not .HasFormula Then


            .Value = UCase$(.Value)
        End If
    End With
        
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
Exit Sub


errHandle:
    'If an error occurs, code below will execute ensuring events and updating are re-enabled
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    MsgBox Err.Description, vbCritical, "Error number: " & Err.Number
    
End Sub


And i need to add this also into it.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)    If Not Intersect(Target, Range("J9")) Is Nothing Then
        If Target.Value <> "" And Target.Cells.Count = 1 Then
            Application.EnableEvents = False
            On Error Resume Next
            Columns("D:D").Find(Target.Value, , , xlWhole, , xlNext).Select
            On Error GoTo 0
            Application.EnableEvents = True
        End If
    End If
End Sub
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Sort by date Sort by votes
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r   As Range
    
    On Error GoTo errHandle 'if we encounter an error, handle it
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    [LEFT][COLOR=#222222][FONT=Verdana]If Not Intersect(Target, Range("J9")) Is Nothing Then[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]        If Target.Value <> "" And Target.Cells.Count = 1 Then[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]            Application.EnableEvents = False[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]            On Error Resume Next[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]            Columns("D:D").Find(Target.Value, , , xlWhole, , xlNext).Select[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]            On Error GoTo 0[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]            Application.EnableEvents = True[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]        End If[/FONT][/COLOR]
[COLOR=#222222][FONT=Verdana]    End If[/FONT][/COLOR]
[/LEFT]
        If Target.Address = "$A$6" Then
            With Sheets("INFO").Range("CG2")
                If Len(.Offset(1).Value) Then
                    Set r = .End(xlDown).Offset(1)
                    With .End(xlDown).Offset(1)
                        .Value = UCase$(ActiveSheet.Cells(6, 1).Value)
                        .Interior.ColorIndex = 6
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlBottom
                        .VerticalAlignment = xlCenter
                        .Borders.LineStyle = xlContinuous
                        .RowHeight = 19.5
                        .Font.Bold = True
                        With ActiveWorkbook.Worksheets("INFO").Sort
                             .SetRange Range("CG2:CG500")
                             .Header = xlYes
                             .MatchCase = False
                             .Orientation = xlTopToBottom
                             .SortMethod = xlPinYin
                             .Apply
                        End With
                    End With
                End If
             End With
        End If
        
    With Target
        If .Column <> 13 And .Count = 1 And Not .HasFormula Then


            .Value = UCase$(.Value)
        End If
    End With
        
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
Exit Sub


errHandle:
    'If an error occurs, code below will execute ensuring events and updating are re-enabled
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    MsgBox Err.Description, vbCritical, "Error number: " & Err.Number
    
End Sub
 
Last edited:
Upvote 0
Thanks for that,

I forgot that this line of code is on a different sheet,the sheet name is ACCOUNTS & cell range is the same J9
Code: 
If Not Intersect(Target, Range("J9")) Is Nothing Then
 
Upvote 0
:warning: NOTE - I did not see your last post before posting this - so you need to take that into account :warning:

It is very easy to make event code unfathomable by inserting multiple conditions.
Additionally, it becomes difficult to spot conditions that overlap etc
I find it better to keep the main procedure clean and call other procedures to do the work.
Simple things are kept, other items are relegated to another procedure.
This may require variables to be passed between procedures or to be declared at the top of the module rendering them available to all procedures within the module (not required here)

I have not tested the code below
- you can do that easily enough yourself
- but it gives you a starting point

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    On Error Resume Next
      
    If Target.Address = "$A$6" Then Call SortINFO

    With Target
        If .Column <> 13 And .Count = 1 And Not .HasFormula Then
            .Value = UCase$(.Value)
        End If
    End With
    
    If Not Intersect(Target, Range("J9")) Is Nothing Then
        If Target.Value <> "" And Target.Cells.Count = 1 Then
                Columns("D:D").Find(Target.Value, , , xlWhole, , xlNext).Select
        End If
    End If    

errHandle:
    'If an error occurs, code below will execute ensuring events and updating are re-enabled
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    If Err.Number > 0 Then MsgBox Err.Description, vbCritical, "Error number: " & Err.Number
    
End Sub

Code: 
Private Sub SortINFO()
    Dim r   As Range
    
        With Sheets("INFO").Range("CG2")
            If Len(.Offset(1).Value) Then
                Set r = .End(xlDown).Offset(1)
                With .End(xlDown).Offset(1)
                        .Value = UCase$(ActiveSheet.Cells(6, 1).Value)
                        .Interior.ColorIndex = 6
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlBottom
                        .VerticalAlignment = xlCenter
                        .Borders.LineStyle = xlContinuous
                        .RowHeight = 19.5
                        .Font.Bold = True
                    With ActiveWorkbook.Worksheets("INFO").Sort
                             .SetRange Range("CG2:CG500")
                             .Header = xlYes
                             .MatchCase = False
                             .Orientation = xlTopToBottom
                             .SortMethod = xlPinYin
                             .Apply
                    End With
                End With
            End If
        End With
End Sub

Note that I have added condition that the error message box only appears if there is an error rendering Exit Sub unnecessary
- the main reason to do this is not have to keep repeating the code to re-enable events etc
- but you must make sure that the code always runs through to the end

It may be better to call a separate procedure to report errors and then that could also be called from SortINFO without duplicating code
- if you use a separate procedure then you will need to pass the error number to the sub
(I have ignored errors in SortINFO - that should be added by you)

There are overlaps in your conditions
- not necessarily an issue
- but there may be times when the code should test one condition first and exit without hitting a second condition activated by the same cell
- if that is necessary place the conditions in the correct sequence and remember to use GoTo ErrHandle not Exit Sub
 
Last edited:
Upvote 0
ipbr21054 said:
Thanks for that,

I forgot that this line of code is on a different sheet,the sheet name is ACCOUNTS & cell range is the same J9
Code: 
If Not Intersect(Target, Range("J9")) Is Nothing Then
Click to expand...

I thought that this would work but when i enter text in the combobox i get no error but also the cell does not get selected for the match ?

Code: 
If Not Intersect(Target, Sheet("ACCOUNTS").Range("J9")) Is Nothing Then
 
Upvote 0
ipbr21054 said:
Thanks for that,

I forgot that this line of code is on a different sheet,the sheet name is ACCOUNTS & cell range is the same J9
Code: 
If Not Intersect(Target, Range("J9")) Is Nothing Then
Click to expand...

Your second macro means "if you change the value of J9 , search the value in column D" and this should be paste in the sheet where j9 is: right click it, select view code and paste it.

Where is the cell A6 that value change launch all kind of formatting on info sheet? If info, then simply right click info, view code and paste your macro.

By the way, the issue with value change is that it launch a macro everytime you change a value on the sheet, which slow down your file and worse, make undo unavailable. I always try to get another option. For example, if change value works on another sheet, I would rather use worksheet activate event...
 
Last edited:
Upvote 0
Hi,

Getting a bit confused now.

Sheet ACCOUNTS is where cell J9 is.

Sheet CLIENT is where the column D is of which the code should select the matched cell.

Sorry i forgot the explain the sheet issue in my first post.

Now not sure if i need to put original code back as it was & add your code to ACCOUNTS sheet ?
 
Upvote 0
ipbr21054 said:
I thought that this would work but when i enter text in the combobox i get no error but also the cell does not get selected for the match ?

Code: 
If Not Intersect(Target, Sheet("ACCOUNTS").Range("J9")) Is Nothing Then
Click to expand...


A combobox? then insert the activeX one, rght click, select code and use something like
Code: 
Sub cBox()
On error resume next
[LEFT][COLOR=#333333][FONT=monospace]            Columns("D:D").Find(combobox1.value, , , xlWhole, , xlNext).Select
Endsub [/FONT][/COLOR][/LEFT]
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question Question
Checkbox doesnt show checkmark when it should
Replies
2
Views
180
ipbr21054
I
D
  • Question Question
Make the code work in a protected sheet
Replies
7
Views
195
dmt32
D
M
  • Solved
Trying to apply 2 Worksheet Changes
Replies
1
Views
235
Joe4
Joe4
excelbytes
  • Solved
Looping Procedure In VBA Code
2 3
Replies
24
Views
478
excelbytes
excelbytes
I
  • Solved
End with without with message
Replies
2
Views
71
ipbr21054
I

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top