Hi,
I have created a data entry macro that prompts the user for information and then enters it in the correct cell of the excel sheet. The user will be entering multiple lines of information so I need the macro called "newentry()" to repeat itself indefinitely, at least until the user clicks "Cancel". I tried adding a loop around the calling of the sub-macros but it won't repeat itself from the beginning once it calls the last macro. Any help is greatly appreciated. Thanks
I have created a data entry macro that prompts the user for information and then enters it in the correct cell of the excel sheet. The user will be entering multiple lines of information so I need the macro called "newentry()" to repeat itself indefinitely, at least until the user clicks "Cancel". I tried adding a loop around the calling of the sub-macros but it won't repeat itself from the beginning once it calls the last macro. Any help is greatly appreciated. Thanks
Code:
Do
Sub newentry()
activate
EnterSO
Enterclientname
Entersizequal
Entertreat
EnterBin
EnterMachine
Enterdate
EnterResult1
EnterResult2
EnterResult3
protect
Loop Until IsEmpty(ActiveSheet.Cells(1, 1))
End Sub
Sub activate()
Sheets("2012 Extraction Results").Select
ActiveSheet.Unprotect
End Sub
Sub EnterSO()
'
' EnterSO Macro
LastRowColB = Range("B65536").End(xlUp).Row
LastSOentry = ActiveSheet.Cells(LastRowColB, 2).Value
SOInput = InputBox(Prompt:="Type the last 5 digits of the SO # or scan the barcode now.", _
Title:="SO # Entry", Default:=LastSOentry)
On Error GoTo protected:
socut = CLng(Right(SOInput, 5))
If SOInput = "Enter SO # here" Or _
SOInput = 0 Or _
SOInput = vbNullString Then
protected:
protect
End
Else
exist = Application.Match(socut, ActiveSheet.Range("B:B"), 0)
If IsError(exist) Then
LastRowColB = Range("B65536").End(xlUp).Row
ActiveSheet.Cells(LastRowColB + 1, 2).Value = socut
Else
customer = Application.VLookup(socut, ActiveSheet.Range("B:J"), 2, False)
sizequal = Application.VLookup(socut, ActiveSheet.Range("B:J"), 3, False)
treatment = Application.VLookup(socut, ActiveSheet.Range("B:J"), 4, False)
doesexist = MsgBox("Prior record of SO # " & socut & " found. Please confirm the details:" & vbNewLine & "Customer: " & customer & vbNewLine & "Size/Qualtiy: " & sizequal & vbNewLine & "Treatment: " & treatment & vbNewLine & "Is this correct?", vbYesNoCancel, "Record of SO # " & socut & " found!")
If doesexist = vbYes Then
LastRowColB = Range("B65536").End(xlUp).Row
ActiveSheet.Cells(LastRowColB + 1, 2).Value = socut
ActiveSheet.Cells(LastRowColB + 1, 3).Value = customer
ActiveSheet.Cells(LastRowColB + 1, 4).Value = sizequal
ActiveSheet.Cells(LastRowColB + 1, 5).Value = treatment
Foundentry
ElseIf doesexist = vbNo Then
LastRowColB = Range("B65536").End(xlUp).Row
ActiveSheet.Cells(LastRowColB + 1, 2).Value = socut
ElseIf doesexist = vbCancel Then
protect
End
End If
End If
End If
End Sub
Sub Enterclientname()
LastRowColB = Range("B65536").End(xlUp).Row
SOInput = ActiveSheet.Cells(LastRowColB, 2).Value
NameInput = InputBox(Prompt:="Type the customer name.", _
Title:="Customer Name for SO# " & SOInput, Default:="Enter customer name here")
If NameInput = "Enter customer name here" Or _
NameInput = vbNullString Then
LastRowColB = Range("B65536").End(xlUp).Row
Range("A" & LastRowColB & ":J" & LastRowColB).ClearContents
protect
End
Else
LastRowColB = Range("B65536").End(xlUp).Row
ActiveSheet.Cells(LastRowColB, 3).Value = NameInput
End If
End Sub
Sub Entertreat()
answer = MsgBox("Bopsil treated?" & vbNewLine & "(clicking No selects paraffin/silicone)", vbYesNoCancel + vbDefaultButton4, "Treatment Entry")
If answer = vbYes Then
treatment = "Bopsil"
ElseIf answer = vbNo Then
treatment = "Paraffin/silicone"
ElseIf answer = vbCancel Then
LastRowColB = Range("B65536").End(xlUp).Row
Range("A" & LastRowColB & ":J" & LastRowColB).ClearContents
protect
End
End If
LastRowColB = Range("B65536").End(xlUp).Row
ActiveSheet.Cells(LastRowColB, 5).Value = treatment
End Sub
Sub Entersizequal()
SizequalInput = InputBox(Prompt:="Type the size/quality (45Nat etc.).", _
Title:="Size/quality Entry for SO# " & SOInput, Default:="Enter size/quality here")
If SizequalInput = "Enter size/quality here" Or _
SizequalInput = vbNullString Then
LastRowColB = Range("B65536").End(xlUp).Row
Range("A" & LastRowColB & ":J" & LastRowColB).ClearContents
protect
End
Else
LastRowColB = Range("B65536").End(xlUp).Row
ActiveSheet.Cells(LastRowColB, 4).Value = SizequalInput
End If
End Sub
Sub EnterBin()
LastRowColB = Range("B65536").End(xlUp).Row
lastbin = ActiveSheet.Cells(LastRowColB - 1, 6).Value + 1
BinInput = InputBox(Prompt:="Scan or type the bin #.", _
Title:="Bin # Entry for SO# " & SOInput, Default:=lastbin)
If BinInput = "Enter bin # here" Or _
BinInput = vbNullString Then
LastRowColB = Range("B65536").End(xlUp).Row
Range("A" & LastRowColB & ":J" & LastRowColB).ClearContents
protect
End
Else
LastRowColB = Range("B65536").End(xlUp).Row
ActiveSheet.Cells(LastRowColB, 6).Value = BinInput
End If
End Sub
Sub EnterMachine()
LastRowColB = Range("B65536").End(xlUp).Row
lastmachine = ActiveSheet.Cells(LastRowColB - 1, 7).Value
If lastmachine = 1 Then
lastmachineedit = lastmachine + 1
Else
lastmachineedit = lastmachine - 1
End If
MachineInput = InputBox(Prompt:="Scan or type the machine #.", _
Title:="Machine # Entry for SO# " & SOInput, Default:=lastmachineedit)
If MachineInput = "Enter machine # here" Or _
MachineInput = vbNullString Then
LastRowColB = Range("B65536").End(xlUp).Row
Range("A" & LastRowColB & ":J" & LastRowColB).ClearContents
protect
End
Else
LastRowColB = Range("B65536").End(xlUp).Row
ActiveSheet.Cells(LastRowColB, 7).Value = MachineInput
End If
End Sub
Sub Enterdate()
LastRowColB = Range("B65536").End(xlUp).Row
lastdate = ActiveSheet.Cells(LastRowColB - 1, 1).Value
DateInput = InputBox(Prompt:="Type the treatment date.", _
Title:="Treatment Date Entry for SO# " & SOInput, Default:=lastdate)
If DateInput = "Enter treatment date here" Or _
DateInput = vbNullString Then
LastRowColB = Range("B65536").End(xlUp).Row
Range("A" & LastRowColB & ":J" & LastRowColB).ClearContents
protect
End
Else
LastRowColB = Range("B65536").End(xlUp).Row
ActiveSheet.Cells(LastRowColB, 1).Value = DateInput
End If
End Sub
Sub EnterResult1()
Result1Input = InputBox(Prompt:="Enter result 1 manually or start the extraction on the Dillon extraction force meter.", _
Title:="Result 1 Entry for SO# " & SOInput, Default:="Enter result 1 here")
If Result1Input = "Enter result 1 here" Or _
Result1Input = vbNullString Then
Exit Sub
Else
LastRowColB = Range("B65536").End(xlUp).Row
ActiveSheet.Cells(LastRowColB, 8).Value = Result1Input
End If
End Sub
Sub EnterResult2()
Result2Input = InputBox(Prompt:="Enter result 2 manually or start the extraction on the Dillon extraction force meter.", _
Title:="Result 2 Entry for SO# " & SOInput, Default:="Enter result 2 here")
If Result2Input = "Enter result 2 here" Or _
Result2Input = vbNullString Then
Exit Sub
Else
LastRowColB = Range("B65536").End(xlUp).Row
ActiveSheet.Cells(LastRowColB, 9).Value = Result2Input
End If
End Sub
Sub EnterResult3()
Result3Input = InputBox(Prompt:="Enter result 3 manually or start the extraction on the Dillon extraction force meter.", _
Title:="Result 3 Entry for SO# " & SOInput, Default:="Enter result 3 here")
If Result3Input = "Enter result 3 here" Or _
Result3Input = vbNullString Then
ActiveSheet.protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True
Exit Sub
Else
LastRowColB = Range("B65536").End(xlUp).Row
ActiveSheet.Cells(LastRowColB, 10).Value = Result3Input
End If
ActiveSheet.protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True
End Sub
Sub protect()
ActiveSheet.protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True
End Sub
Sub Lastrow()
'
' Lastrow Macro
LastRowColB = Range("B65536").End(xlUp).Row
ActiveSheet.Cells(LastRowColB + 1, 1).Value = LastRowColB
ActiveSheet.Cells(LastRowColB + 1, 2).Value = [G1].Value
'
End Sub
Sub Foundentry()
EnterBin
EnterMachine
Enterdate
EnterResult1
EnterResult2
EnterResult3
End
End Sub
Last edited: