Change macro stops

[wills444]

I wrote this program to take some data that was being transferred to my tablet through a keyboard wedge software and put it into our inspection sheet. It takes data from a few different types of inspection eq and the data string was different for each so I had to pull the number from different parts of the string. It works well but some times the macro will just be turned off. It will display the raw string of data when it is transferred to the tablet instead of automatically pulling out the number I am looking for.

Also, lower in the code I say if the number that I pull from the data is not within my high and low tolerances it will turn red. Sometimes this code will not work either so again it just seems like the code turns off. We can close all excel documents and reopen and it will work but it is now happening so much it is becoming a problem. Is there something that I didn't set up correctly that this would happen?

I appreciate your help!

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.

key_coor = "B14" & ":" & "AG" & Sheets("Input Sheet").Cells(40, 1)
Set KeyCells = Sheets("Insp. Sheet Final").Range(key_coor)
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then


Application.EnableEvents = False
ActiveCell.Offset(RowOffset:=-1, ColumnOffset:=0).Activate
If ActiveCell.Row > 13 Then
If InStr(1, ActiveCell.Value, "M") Then '90 series Keyence output
peak_check = ActiveCell.Column + 4
If Sheets("Input Sheet").Cells(peak_check, 5).Value = "True" Then 'see if peak value is toggled
If Sheets("Input Sheet").Cells(40, 2) = "Recording" Then 'check to see if already recording
'Sheets("Input Sheet").Cells(40, 2) = "" 'reset recording indicator
ActiveCell.Value = Round(Mid(ActiveCell.Value, 28, 8), 5) 'get value from code
End If
If Sheets("Input Sheet").Cells(40, 2) = "" Then 'check to see if already recording
ActiveCell.Value = "Recording..." 'indicate in recording mode if button clicked for first time
Sheets("Input Sheet").Cells(40, 2) = "Recording"
End If
If ActiveCell.Value <> "Recording..." And Sheets("Input Sheet").Cells(40, 2) = "Recording" Then
Sheets("Input Sheet").Cells(40, 2) = ""
End If
Else
ActiveCell.Value = Round(Mid(ActiveCell.Value, 8, 8), 5) 'get value from code
End If
End If
If InStr(12, ActiveCell.Value, ",") Then 'Deltronic output
If X_value.BackColor = 52582 Then 'if x button clicked
ActiveCell.Value = Round(Mid(ActiveCell.Value, 3, 10), 4)
End If
If Y_value.BackColor = 52582 Then 'if y button clicked
ActiveCell.Value = Round(Mid(ActiveCell.Value, 16, 10), 4)
End If
If Ang_Value.BackColor = 52582 Then 'if ang button clicked
ActiveCell.Value = ""
MsgBox "This Option is Not Available on This Insp. Device"
End If
End If
If InStr(46, ActiveCell.Value, "x") Then 'OGP output (new)
If X_value.BackColor = 52582 Then 'if x button clicked
ActiveCell.Value = Round(Mid(ActiveCell.Value, 4, 8), 4)
End If
If Y_value.BackColor = 52582 Then 'if y button clicked
ActiveCell.Value = Round(Mid(ActiveCell.Value, 20, 8), 4)
End If
If Ang_Value.BackColor = 52582 Then 'if ang button clicked
ActiveCell.Value = ""
MsgBox "This Option is Not Available on This Insp. Device"
End If
End If
If InStr(23, ActiveCell.Value, "P") Then 'OGP output (old)
If X_value.BackColor = 52582 Then 'if x button clicked
ActiveCell.Value = Round(Mid(ActiveCell.Value, 3, 5), 4)
End If
If Y_value.BackColor = 52582 Then 'if y button clicked
ActiveCell.Value = Round(Mid(ActiveCell.Value, 14, 5), 4)
End If
If Ang_Value.BackColor = 52582 Then 'if ang button clicked
ActiveCell.Value = Round(Mid(ActiveCell.Value, 25, 4), 4)
End If
End If

'turn all values positive and blank if 0
If ActiveCell.Value <> "Recording..." Then
ActiveCell.Value = Abs(ActiveCell.Value)
End If
If ActiveCell.Value = 0 Or ActiveCell.Value = "" Then
ActiveCell.Value = ""
End If

'turn number red if it is out of tolerance
low_tolerance_active = Sheets("Insp. Sheet Final").Cells(13, ActiveCell.Column)
low_tolerance_mod = Val(Mid(low_tolerance_active, 1, 6))
high_tolerance_active = Sheets("Insp. Sheet Final").Cells(11, ActiveCell.Column)
high_tolerance_mod = Val(Mid(high_tolerance_active, 1, 6))
rowNumberValue = ActiveCell.Row
columnNumberValue = ActiveCell.Column
If low_tolerance_mod <= ActiveCell.Value And high_tolerance_mod >= ActiveCell.Value Then
ActiveCell.Font.Color = vbBlack
Else
ActiveCell.Font.Color = vbRed
End If
End If

Application.EnableEvents = True
If ActiveCell.Value = "Recording..." Then
Else
Application.SendKeys "{Enter}"
End If
End If
End Sub

 

[Joe4]

Welcome to the Board!

It works well but some times the macro will just be turned off.

I have a pretty good idea what might be happening, and it revolves around this line here:

[COLOR=#333333]Application.EnableEvents = False[/COLOR]

Do you understand what this line does? It disables Event Procedure Code (like this) from running. It is often added to this kind of code, as this is code that is automatically triggered when a cell is updated. But what if your code, itself, updates cells? Then the code will keep calling itself (as it is changing things), and you could possibly get caught in an infinite loop!

So, this line of code is often added before making changes via the code to "temporarily" disable the code from calling itself. And then, you want to make sure you turn it back on before exiting the code (often near the end) with a line line this:

[COLOR=#333333]Application.EnableEvents = True[/COLOR]

However, it your code gets interrupted, or somehow ends of exits without hitting this line, the code will be disabled (as all Event Procedure code is being disabled by that row). So you may need to turn it back on, by running a simple macro like this:

Sub TurnItBackOn()
[COLOR=#333333]    Application.EnableEvents = True
Exit Sub[/COLOR]

So you can always use that in a pinch. Shutting down Excel and re-opening it will also reset it back to normal.