VBA loop not functioning - Please help!

DwinZly

Board Regular
Joined
Oct 26, 2009
Messages
56
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

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:
There are two ways to set a value within Function2 to be used by Function1;

1. In line with the context of our discussions;

An example
Code:
[FONT="Consolas"][SIZE="2"][COLOR="Navy"]Option Explicit

Function Function1() As Integer

[COLOR="Green"]    '*
    '* Declare variables
    '*

    '*
    '* Code
    '*

    '* Assign the return value of Function2 to a variable
    '*  in order to use it inside Function1[/COLOR]
    Function2ReturnValue = Function2

[COLOR="green"]    '*
    '* In case the return value from Function2 is not 1
    '*[/COLOR]
    Select Case Function2ReturnValue
        Case -1         [COLOR="green"]'* There is a problem[/COLOR]
            Function1 = Function2ReturnValue
            Exit Function

        Case 2          [COLOR="green"]'* Something is missing[/COLOR]
[COLOR="green"]            '*
            '* Code
            '*[/COLOR]
            Function1 = 5
            Exit Function

        Case Else       [COLOR="green"]'* Everything is fine[/COLOR]
[COLOR="green"]            '*
            '* Code
            '*[/COLOR]
            Function1 = 1

    End Select

End Function

Function Function2() As Integer

[COLOR="green"]    '*
    '* Declare variables
    '*

    '*
    '* Code
    '*[/COLOR]

    If ThereIsProplem Then
        Function2 = -1
        Exit Function
    End If

[COLOR="green"]    '*
    '* Code
    '*[/COLOR]

    If SomethingIsMissing Then
        Function2 = 2
        Exit Function
    End If

    [COLOR="green"]'* If everything is fine[/COLOR]
    Function2 = 1

End Function[/COLOR][/SIZE][/FONT]
As you can see from the example, Function2 returns more than one value depending on certain conditions. Function1 from its side has also its own set of return values that depends on other conditions.

You can call as many functions as you need and each function can have its own set of return values.

2. Using a Public/Private variable (please refer to Excel VBA help on Public Statement and Private Statement for more details)

You may declare one or more Public or Private variables that can be used by all procedures and functions in your project. The good thing with this type of variables is one procedure/function can set its value and others can use and even change it without the need to pass it as argument or returned as a value.

An example
Code:
[FONT="Consolas"][SIZE="2"][COLOR="Navy"]Option Explicit

Private GeneralVariable As Long

Sub MainProcedure()

[COLOR="green"]    '*
    '* Declare variables
    '*

    '*
    '* Code
    '*[/COLOR]
    GeneralVariable = 100                   [COLOR="green"]'* Initial value[/COLOR]
    If Function1 = -1 Then Exit Sub
    GeneralVariable = GeneralVariable + 2   [COLOR="green"]'* GeneralVariable = 104[/COLOR]

End Sub

Function1() As Integer

[COLOR="green"]    '*
    '* Declare variables
    '*

    '*
    '* Code
    '*[/COLOR]

    If ThereIsProplem Then
        Function1 = -1
        Exit Function
    End If
    GeneralVariable = GeneralVariable + 2       [COLOR="green"]'* GeneralVariable = 102[/COLOR]
    Function1 = 1

End Function[/COLOR][/SIZE][/FONT]
The type of return values and/or the Public/Private variables is specified based on the need. There is no rule to specify whether to use Boolean, Integer, or any other type.
 
Upvote 0

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

Forum statistics

Threads
1,223,246
Messages
6,170,996
Members
452,373
Latest member
TimReeks

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top