Excel VBA

[accuchek]

I have created a VBA macro that provides a review of inspection data:

Nominal=10
Accuracy=±2
Inspection Data: 10,10,12,15,10

The macro reviews each data record against the upper and lower limits of the specification.

I have the macro assigned to a hostspot of an image. My users have to click it to run the macro after data is inputted.

QUESTION:
How can this be automated so the macro will run on any update or change of data versus manually clicking a button?

[DKenny]

You can have it run automatically by adding your code to the Worksheet_Change event procedure for the sheet in question.

[accuchek]

Thanks for your reply. I am obviously a beginner in this realm!

Do you have any sample code? I am not sure how to handle the "Target" in my application.

[DKenny]

BTW, welcome to the forums

The Target is the cell that is being changed by the user (which is the event that triggers this code to execute).
If you want to check the value of the datum being entered by the user against your specs, then you would get the value of the Target cell and then use it to compare.

Here's some pseudo-code to give you the idea. If you post your current code then we can tweak it.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim dInputValue As Double
    
    'First we check if the value entered is numeric
    If IsNumeric(Target.Value) Then
        
        'Then we pass it to a variable
        dInputValue = Target.Value
        
         'now test the dInputValue variable against your specs
    End If
    
End Sub

[accuchek]

Sub AccuracyCheck()

'Have x start at row 9 and y start at column 7.

x = 9
y = 7

'This loops the macro for each row of measured features of the report until a blank row is found.
Do While Cells(x, 7).Value <> ""

'This makes sure the "Status" field begins with a blue "ok" statement.
Cells(x, 14).Value = "ok"
Cells(x, 14).Font.ColorIndex = 5
Cells(x, 14).Font.FontStyle = "Normal"

'This loops the macro to checks each sample within the report until a blank column is found.
Do While Cells(x, y).Value <> ""

'This checks to see what type of tolerance there is: Bi-Lateral, Minus,or plus.
'Bi-Lateral Formulas
If Cells(x, 4) = "Bi-Lateral" Then

'Then it checks if the measured value is in/out based on a bi-lateral tolerance.
If Cells(x, y).Value < Cells(x, 5).Value - Cells(x, 6).Value / 2 Or Cells(x, y).Value > Cells(x, 5).Value + Cells(x, 6).Value / 2 Then

'If found "OOT"; sets the text of the measured value to red and sets the background to grey.
Cells(x, y).Interior.ColorIndex = 6
Cells(x, y).Font.ColorIndex = 3
Cells(x, y).Font.FontStyle = "Bold"

'In the event corrections are made; resets the font and background back to normal if now in tolerance.
ElseIf Cells(x, y).Value >= Cells(x, 5).Value - Cells(x, 6).Value / 2 Or Cells(x, y).Value <= Cells(x, 5).Value + Cells(x, 6).Value / 2 Then

Cells(x, y).Interior.ColorIndex = 0
Cells(x, y).Font.ColorIndex = 1
Cells(x, y).Font.FontStyle = "Normal"

End If

'This will place a red "OOT" in the "Status" when there is an OOT condition found for that feature.
If Cells(x, y).Value < Cells(x, 5).Value - Cells(x, 6).Value / 2 Or Cells(x, y).Value > Cells(x, 5).Value + Cells(x, 6).Value / 2 Then

Cells(x, 14).Value = "OOT"
Cells(x, 14).Font.ColorIndex = 3

End If

'Minus Formulas
ElseIf Cells(x, 4) = "Minus" Then

'Then it checks if the measured value is in/out based on a minus tolerance.
If Cells(x, y).Value < Cells(x, 5).Value - Cells(x, 6).Value Or Cells(x, y).Value > Cells(x, 5).Value Then

'If found "OOT"; sets the text of the measured value to red and sets the background to grey.
Cells(x, y).Interior.ColorIndex = 6
Cells(x, y).Font.ColorIndex = 3
Cells(x, y).Font.FontStyle = "Bold"

'In the event corrections are made; resets the font and background back to normal if now in tolerance.
ElseIf Cells(x, y).Value >= Cells(9, 5).Value - Cells(9, 6).Value Or Cells(9, y).Value <= Cells(9, 5).Value Then

Cells(x, y).Interior.ColorIndex = 0
Cells(x, y).Font.ColorIndex = 1
Cells(x, y).Font.FontStyle = "Normal"

End If

'This will place a red "OOT" in the "Status" when there is an OOT condition found for that feature.
If Cells(x, y).Value < Cells(x, 5).Value - Cells(x, 6).Value Or Cells(x, y).Value > Cells(x, 5).Value Then

Cells(x, 14).Value = "OOT"
Cells(x, 14).Font.ColorIndex = 3

End If

'Plus Formulas
ElseIf Cells(x, 4) = "Plus" Then

'Then it checks if the measured value is in/out based on a plus tolerance.
If Cells(x, y).Value < Cells(x, 5).Value Or Cells(x, y).Value > Cells(x, 5).Value + Cells(x, 6).Value Then

'If found "OOT"; sets the text of the measured value to red and sets the background to grey.
Cells(x, y).Interior.ColorIndex = 6
Cells(x, y).Font.ColorIndex = 3
Cells(x, y).Font.FontStyle = "Bold"

'In the event corrections are made; resets the font and background back to normal if now in tolerance.
ElseIf Cells(x, y).Value >= Cells(x, 5).Value Or Cells(x, y).Value <= Cells(x, 5).Value + Cells(x, 6).Value Then

Cells(x, y).Interior.ColorIndex = 0
Cells(x, y).Font.ColorIndex = 1
Cells(x, y).Font.FontStyle = "Normal"

End If

'This will place a red "OOT" when there is an OOT condition found for that feature.
If Cells(x, y).Value < Cells(x, 5).Value Or Cells(x, y).Value > Cells(x, 5).Value + Cells(x, 6).Value Then

Cells(x, 14).Value = "OOT"
Cells(x, 14).Font.ColorIndex = 3

End If

End If

'increase the value of y by 1 to act on the next column
y = y + 1
Loop

'increase the value of x by 1 to act on the next row
x = x + 1

'reset the column to 7 to start checking the values of the next row at the first entry
y = 7

Loop

End Sub

[accuchek]

This was written to compare 5 sample's measurement data against the drawing information (nominal value, type of tolerance, and tolerance range). If any one sample fails- turn the text bold and red and turn the background yellow. Also, at the end of the data stream, if it fails, put the letters "OOT" (Out of Tolerance) in the next column. Do this for as many rows of data available.

[DKenny]

Why are you using code to do this? All this can be achieved with formulas and conditional formatting on the sheet.

[accuchek]

Using formulas, I had to embed too many "IF" statements in order to satisfy my end result. Excel would not allow it.

[DKenny]

I may be way off here, but based on the info you have provided I came up with a demo that I think will give you what you need without any VBA code.

Have a look at the attached s/sheet and try some of you data in the box to see if the formulas and conditional formatting are working. I've tried to match to your columns as much as possible, without having seen your worksheet.