Vba code to check if produced pieces are greater than 104%

Hello I am Trying To Create an Vba Code Check, a Po numbers Produced pieces is above 104%, so the program would take the Po. and the produces pieces as input and would check if the produced pieces exceeds 104% and return an error.

This Would allow the user to input the Po.number

Public Sub Pobox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim x As Integer
x = 1
Dim trovato As Boolean 'found=trovato
trovato = False
'Dim Labelstyle, Labelcolor As String

'Sheets("PO summary").Activate
Do Until Sheet2.Cells(1 + x, 1) = ""
If Sheet2.Cells(1 + x, 1) = Pobox.Value Or Sheet2.Cells(1 + x, 10) = Pobox.Value Then
Labelstyle = Sheet2.Cells(1 + x, 13)
Labelcolor = Sheet2.Cells(1 + x, 14)
trovato = True
End If
x = x + 1
Loop
'Sheets("INSERT").Activate

If trovato = False And Pobox.Value <> "" Then
MsgBox "PO not valid"
Pobox.Value = ""
End If

End Sub


And This Would Search for the Po.Number and if found, it would then Check for Size same row but different column, and lastly if it finds the last two it would check the Produced Pieces and Check if its greater than 104% then it would return error

Private Sub Lbox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii > 58 Or KeyAscii < 48 Then
KeyAscii = 0
MsgBox ("enter number ")
Lbox.SetFocus
End If
With Worksheets(4).Range("j2:j1048576")
Set c = .Find(Pobox.Value, LookIn:=xlValues)
End With
If Not c Is Nothing Then
With Worksheets(4).Range("s2:s1048576")
Set d = .Find("L", LookIn:=xlValues)
End With
If Not d Is Nothing Then

With Worksheets(4).Range("u2:u1048576")
Set d = .Find("L", LookIn:=xlValues)
End With
If e > 1.04 Then
MsgBox "Too Large "
End If
End If
End If
End Sub


1 Answer
1

I'm not sure what "L" or "e" are but apart from that I'll try using a loop:

Sub Lbox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

If KeyAscii > 58 Or KeyAscii < 48 Then
KeyAscii = 0
MsgBox ("enter number ")
Lbox.SetFocus
End If


With ActiveSheet.UsedRange

Set c = .Cells.Find(What:="d", SearchOrder:=xlByRows)

If Not c Is Nothing Then
Do Until c Is Nothing

If c.Column = 10 Then

Set d = .Cells(c.Row).Find(What:="L", SearchOrder:=xlByRows)

If Not d Is Nothing Then

Set d = .FindNext(d)

If Not d Is Nothing Then
Do Until d Is Nothing
Set d = .FindNext(d)
If d.Column = 21 Then

If e > 1.04 Then

MsgBox "Match"

End If

End If
Loop
End If

End If
End If
Set c = .FindNext(c)
Loop
End If

End With

End Sub


Find

MsgBox

By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.