Adding code to existing worksheet change event

[ipbr21054]

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.

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.

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

 

[Kamolga]

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

 

[ipbr21054]

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

If Not Intersect(Target, Range("J9")) Is Nothing Then

 

[Yongle]

NOTE - I did not see your last post before posting this - so you need to take that into account

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

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

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

 

[ipbr21054]

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

If Not Intersect(Target, Range("J9")) Is Nothing Then

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 ?

If Not Intersect(Target, Sheet("ACCOUNTS").Range("J9")) Is Nothing Then

 

[Kamolga]

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

If Not Intersect(Target, Range("J9")) Is Nothing Then

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...

 

[ipbr21054]

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 ?

 

[Kamolga]

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 ?

If Not Intersect(Target, Sheet("ACCOUNTS").Range("J9")) Is Nothing Then

A combobox? then insert the activeX one, rght click, select code and use something like

Sub cBox()
On error resume next
[LEFT][COLOR=#333333][FONT=monospace]            Columns("D:D").Find(combobox1.value, , , xlWhole, , xlNext).Select
Endsub [/FONT][/COLOR][/LEFT]

 

[ipbr21054]

Thanks,
Its is now working