Private Sub Routine is not functioning

Brass Contributor

Hi

 

What would be the reason for, not working Private sub routine automatically whenever any changes done in range. 

 

Private Sub Worksheet_Change(ByVal Target As Range)

whenever I restart the excel it will work for a little time and later it become not respondive. 

 

please help me on this

 

6 Replies
Without, at the very least, the macro code to look at, it's very hard to say (a copy of the workbook would be ideal, if there is no sensitive information or if the sensitive information could be deleted).

But, taking a shot in the dark, does your change event make changes to the worksheet? If so, then you could potentially have an infinite loop (where the change event makes a change that triggers itself). If you are making changes to the worksheet, then you will need to disable events before you make the changes:
Application.EnableEvents = False

and re-enable events before the macro exits:
Application.EnableEvents = False
I tried this, its not working.

Please see the code below. Its a data entry form, and the codes are using for jumping to next cell after the entry.

Private Sub Worksheet_Change(ByVal Target As Range)
MyVal = Range("Total4").Value

With ActiveSheet.Tab
Select Case MyVal
Case Is > 0
.Color = vbBlack
Case Is = 0
.Color = vbRed
Case Else
.ColorIndex = xlColorIndexNone
End Select
End With

If Not Intersect(Target, Me.Range("b:b")) Is Nothing Then
Target.Offset(0, 1).Activate
ElseIf Not Intersect(Target, Me.Range("c:c")) Is Nothing Then
Target.Offset(1, -1).Activate

End If
If Not Intersect(Target, Me.Range("e:e")) Is Nothing Then
Target.Offset(0, 1).Activate
ElseIf Not Intersect(Target, Me.Range("f:f")) Is Nothing Then
Target.Offset(1, -1).Activate

End If
If Not Intersect(Target, Me.Range("h:h")) Is Nothing Then
Target.Offset(0, 1).Activate
ElseIf Not Intersect(Target, Me.Range("i:i")) Is Nothing Then
Target.Offset(1, -1).Activate

'OB
End If
If Not Intersect(Target, Me.Range("d18")) Is Nothing Then
Target.Offset(-6, 0).Activate
ElseIf Not Intersect(Target, Me.Range("d12")) Is Nothing Then
Target.Offset(-1, 0).Activate
End If
If Not Intersect(Target, Me.Range("d11")) Is Nothing Then
Target.Offset(7, 3).Activate
ElseIf Not Intersect(Target, Me.Range("g18")) Is Nothing Then
Target.Offset(-6, 0).Activate
End If
If Not Intersect(Target, Me.Range("g12")) Is Nothing Then
Target.Offset(-1, 0).Activate
ElseIf Not Intersect(Target, Me.Range("g11")) Is Nothing Then
Target.Offset(3, -3).Activate
End If

If Not Intersect(Target, Me.Range("d22")) Is Nothing Then
Target.Offset(0, 3).Activate
ElseIf Not Intersect(Target, Me.Range("g22")) Is Nothing Then
Target.Offset(1, -3).Activate
End If

If Not Intersect(Target, Me.Range("d16")) Is Nothing Then
Target.Offset(-3, 3).Activate
ElseIf Not Intersect(Target, Me.Range("g16")) Is Nothing Then
Target.Offset(0, -3).Activate
End If

If Not Intersect(Target, Me.Range("d20")) Is Nothing Then
Target.Offset(-1, 0).Activate
ElseIf Not Intersect(Target, Me.Range("d19")) Is Nothing Then
Target.Offset(1, 3).Activate
End If

If Not Intersect(Target, Me.Range("g20")) Is Nothing Then
Target.Offset(-1, 0).Activate
ElseIf Not Intersect(Target, Me.Range("g19")) Is Nothing Then
Target.Offset(1, -3).Activate
End If

If Not Intersect(Target, Me.Range("d10")) Is Nothing Then
Target.Offset(-1, 0).Activate

ElseIf Not Intersect(Target, Me.Range("d9")) Is Nothing Then
Target.Offset(-1, 0).Activate
End If
If Not Intersect(Target, Me.Range("d8")) Is Nothing Then
Target.Offset(2, 3).Activate

ElseIf Not Intersect(Target, Me.Range("g10")) Is Nothing Then
Target.Offset(-1, 0).Activate
End If

If Not Intersect(Target, Me.Range("g9")) Is Nothing Then
Target.Offset(-1, 0).Activate

ElseIf Not Intersect(Target, Me.Range("g8")) Is Nothing Then
Target.Offset(0, -3).Activate
End If
If Not Intersect(Target, Me.Range("d26")) Is Nothing Then
Target.Offset(0, 3).Activate

ElseIf Not Intersect(Target, Me.Range("g26")) Is Nothing Then
Target.Offset(0, -3).Activate
End If

End Sub
Its working first time after the excel restarts.

@Sameer_Kuppanath_Sultan 

 

Your code is fine and it should work as you haven't disabled Events in your change event code.
Is there any other code where you have disabled the Events with the following line?
Application.EnableEvents = False

If so please make sure that you enable the Events again before the End Sub or Exit Sub if any in your code.

Btw try this version and see if this works for you. This is a workaround but you will have to figure it out why Events are being disabled. To check that when your code stops working, open the Immediate window by pressing Ctrl+G and type ?Application.EnableEvents in there and hit Enter.
What do you get in the Immediate Window, a True or a False?

 

Private Sub Worksheet_Change(ByVal Target As Range)
MyVal = Range("Total4").Value

On Error GoTo Skip

With ActiveSheet.Tab
Select Case MyVal
Case Is > 0
.Color = vbBlack
Case Is = 0
.Color = vbRed
Case Else
.ColorIndex = xlColorIndexNone
End Select
End With

If Not Intersect(Target, Me.Range("b:b")) Is Nothing Then
    Target.Offset(0, 1).Activate
ElseIf Not Intersect(Target, Me.Range("c:c")) Is Nothing Then
    Target.Offset(1, -1).Activate
End If

If Not Intersect(Target, Me.Range("e:e")) Is Nothing Then
    Target.Offset(0, 1).Activate
ElseIf Not Intersect(Target, Me.Range("f:f")) Is Nothing Then
    Target.Offset(1, -1).Activate
End If

If Not Intersect(Target, Me.Range("h:h")) Is Nothing Then
    Target.Offset(0, 1).Activate
ElseIf Not Intersect(Target, Me.Range("i:i")) Is Nothing Then
    Target.Offset(1, -1).Activate
'OB
End If

If Not Intersect(Target, Me.Range("d18")) Is Nothing Then
    Target.Offset(-6, 0).Activate
ElseIf Not Intersect(Target, Me.Range("d12")) Is Nothing Then
    Target.Offset(-1, 0).Activate
End If

If Not Intersect(Target, Me.Range("d11")) Is Nothing Then
    Target.Offset(7, 3).Activate
ElseIf Not Intersect(Target, Me.Range("g18")) Is Nothing Then
    Target.Offset(-6, 0).Activate
End If

If Not Intersect(Target, Me.Range("g12")) Is Nothing Then
    Target.Offset(-1, 0).Activate
ElseIf Not Intersect(Target, Me.Range("g11")) Is Nothing Then
    Target.Offset(3, -3).Activate
End If

If Not Intersect(Target, Me.Range("d22")) Is Nothing Then
    Target.Offset(0, 3).Activate
ElseIf Not Intersect(Target, Me.Range("g22")) Is Nothing Then
    Target.Offset(1, -3).Activate
End If

If Not Intersect(Target, Me.Range("d16")) Is Nothing Then
    Target.Offset(-3, 3).Activate
ElseIf Not Intersect(Target, Me.Range("g16")) Is Nothing Then
    Target.Offset(0, -3).Activate
End If

If Not Intersect(Target, Me.Range("d20")) Is Nothing Then
    Target.Offset(-1, 0).Activate
ElseIf Not Intersect(Target, Me.Range("d19")) Is Nothing Then
    Target.Offset(1, 3).Activate
End If

If Not Intersect(Target, Me.Range("g20")) Is Nothing Then
    Target.Offset(-1, 0).Activate
ElseIf Not Intersect(Target, Me.Range("g19")) Is Nothing Then
    Target.Offset(1, -3).Activate
End If

If Not Intersect(Target, Me.Range("d10")) Is Nothing Then
    Target.Offset(-1, 0).Activate
ElseIf Not Intersect(Target, Me.Range("d9")) Is Nothing Then
    Target.Offset(-1, 0).Activate
End If

If Not Intersect(Target, Me.Range("d8")) Is Nothing Then
    Target.Offset(2, 3).Activate
ElseIf Not Intersect(Target, Me.Range("g10")) Is Nothing Then
    Target.Offset(-1, 0).Activate
End If

If Not Intersect(Target, Me.Range("g9")) Is Nothing Then
    Target.Offset(-1, 0).Activate
ElseIf Not Intersect(Target, Me.Range("g8")) Is Nothing Then
    Target.Offset(0, -3).Activate
End If

If Not Intersect(Target, Me.Range("d26")) Is Nothing Then
    Target.Offset(0, 3).Activate
ElseIf Not Intersect(Target, Me.Range("g26")) Is Nothing Then
    Target.Offset(0, -3).Activate
End If
Skip:
Application.EnableEvents = True
End Sub

@Sameer_Kuppanath_Sultan 

 

I don't see any issues with your code. By chance, do you have other event procedures, such as "selection_change"?

 

Another thing you could try, is setting a break point in your code (click in the gray area to the left and you see a circle with the line highlighted - click again to remove it). When your code runs, it will stop on this line. Then, you can hit the F8 key to step through it and follow the flow of your program. Perhaps it will help identify where the issue is.

JMB17_0-1615133971162.png

 

 

 

See I tried. still its not working, but its working all "open" excel sheet closes and restart the excel.

So my doubt is on other excel sheets opened and which had already codes.