Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

Problem with Do Loop

0
Sub Macro7()
Dim rVillaNo As Range
Dim resName As String
Dim Resp As String
Dim Meal As VbMsgBoxResult, GFO As VbMsgBoxResult

Sheets("Residents").Select
ActiveSheet.Unprotect
Range("j1").Select
Resp = InputBox(" What is the Resident's Villa No?.")
Application.EnableEvents = False
If Len(Resp) > 0 Then
    On Error Resume Next
    Set rVillaNo = Range("VillaNo").Find(What:=Resp, LookAt:=xlWhole, SearchDirection:=xlDown)
    If Not rVilla Is Nothing Then
'Do
       Application.Goto Reference:=rVillaNo.Offset(0, -3), Scroll:=True
        resName = rVillaNo.Offset(n, -2) & " " & rVillaNo.Offset(n, -1)
        Meal = MsgBox("Is    " & resName & "   Coming?", vbYesNo, " Who is coming From Villa   " & Resp)
        Select Case Meal
            Case vbYes
            rVillaNo.Offset(n, -3).Value = 1
            GFO = MsgBox(("Does    " & resName & " require a Gluten Free meal ?"), vbYesNo, "Gluten Free Meal for Villa Number   " & Resp)
                If GFO = vbYes Then
                     rVillaNo.Offset(n, 2) = "Y"
                 Else
                     rVillaNo.Offset(n, 2).Value = ""
                End If
             Case vbNo
            rVillaNo.Offset(n, -3).Value = ""
             Case Else
            'Exit Sub
            End Select
            n = n + 1
'Loop Until rVillaNo.Offset(n, 0).Value <> rVillaNo.Value
        End If
        End If
   Application.EnableEvents = True

End Sub

I am having trouble inserting one futher prompt in the loop. The code above works fine and I have removed the colour coding

InputBox= ("Whose table will Resident be sitting At") 

response is  a Name eg "Alphonso"

Some Villa have 2 residents. It need to loop to ask the  prompty for each resident.

The registration form  from which all the input data  is  sourced  limits table sizes  to 4,10, or 16. There is no need  code the table limits.

I have also attached my  part of my file 

many Thanks for you help 

Garry

Answer
Discuss

Discussion

Wilson

Please edit your question to add your new file (your offsets seem to have changed from your previous file so I'd like to get it right!).

Also, you missed the right place to add the code- use the CODE button and end [/CODE] marker, i.e. it should replace the text "Code_Goes_Here".

In fact you can delete the starting [ in your question and CODE]Code_Goes_Here[/CODE] further down then select from Sub Macro... to End Sub and click the CODE button (then Update).

Also, have you given any thought to controlling the numbers on a table (or offering the available ones)? Or isn't that an issue?
John_Ru (rep: 6232) Oct 31, '23 at 8:46 am
Thanks for doing that- please see my Answer.
John_Ru (rep: 6232) Oct 31, '23 at 6:48 pm
Hi John,
Many thanks for you assistance.
Garry
Wilsons51 (rep: 4) Nov 2, '23 at 3:54 pm
Great! Thanks for selecting my Answer, Garry. 
John_Ru (rep: 6232) Nov 2, '23 at 3:57 pm
Add to Discussion

Answers

0
Selected Answer

Garry (Wilson)

Thanks for the file- that nearly always helps us! Try to do that with future questions please

In the attached revised file, I've assigned a modified version of your macro (below) to the button labelled "Add New  Reservation for  Resident".

The changes made include:

  1. declaring a new variable Tbl (to record the chosen table name)
  2. disabling J1 cell selection and event disabling (not really needed with a macro doing only a few things)
  3. restoring the Do/ Loop Until statements (to capture a response for each resident of a Villa)
  4. adding InputBox code (which will offer a second resident the same as that chosen by the first, if they're attending).
  5. removed several extra spaces in messages.

Main changes are in bold below:

Sub Macro7()

    Dim rVillaNo As Range, resName As String, Resp As String

    Dim Meal As VbMsgBoxResult, GFO As VbMsgBoxResult

    Dim Tbl As String


    Sheets("Residents").Select

    ActiveSheet.Unprotect

    'Range("j1").Select

    Resp = InputBox("What is the Resident's Villa No?.")

    'Application.EnableEvents = False

    If Len(Resp) > 0 Then

        On Error Resume Next

        Set rVillaNo = Range("VillaNo").Find(What:=Resp, LookAt:=xlWhole, SearchDirection:=xlDown)

        If Not rVilla Is Nothing Then

            ' use the Do/ Loop Until to get other names in Villa...
            Do

                   Application.Goto Reference:=rVillaNo.Offset(0, -3), Scroll:=True

                    resName = rVillaNo.Offset(n, -2) & " " & rVillaNo.Offset(n, -1)

                    Meal = MsgBox("Is " & resName & " coming?", vbYesNo, "Who is coming From Villa " & Resp & "?")

                    Select Case Meal

                        Case vbYes

                        rVillaNo.Offset(n, -3).Value = 1

                        GFO = MsgBox(("Does " & resName & " require a Gluten Free meal ?"), vbYesNo, "Gluten Free Meal for Villa Number " & Resp)

                            If GFO = vbYes Then

                                 rVillaNo.Offset(n, 2) = "Y"

                             Else

                                 rVillaNo.Offset(n, 2).Value = ""

                            End If

                            ' this will offer same table as previous Villa resident but can be over-typed
                            Tbl = InputBox("Whose table will " & resName & " be sitting at? (Enter name)", "Requested table", Tbl)

                             ' write to column E
                             rVillaNo.Offset(n, 1).Value = Tbl

                         Case vbNo
                            ' clear booking entries
                            rVillaNo.Offset(n, -3).Value = ""
                            rVillaNo.Offset(n, 2).Value = ""
                            rVillaNo.Offset(n, 1).Value = ""

                         Case Else

                        'Exit Sub



                        End Select

                        n = n + 1

                        Loop Until rVillaNo.Offset(n, 0).Value <> rVillaNo.Value

                    End If

            End If

       'Application.EnableEvents = True

End Sub

Revision 02 November 2023:

Further to the user's follow-on question, the second attached file allows the user to complete a booking then make another (or quit).

It adds a new variable (near the start), in bold:

    Dim Tbl As String, Bck As VbMsgBoxResult

' marker for subsequent bookings
Coda:

and sets a place (randomly Coda, from music!) for the code to jump back to, if chosen.

The end of the code  has the changes in bold (with explanatory comments) 

        ' additional code to allow subsequent bookings  

        Bck = MsgBox(("Done! Want to make a booking for another Villa?"), vbYesNo, "Completed booking for Villa Number " & Resp)

        If Bck = vbYes Then
            ' reset variables
            Set rVillaNo = Nothing
            resName = ""
            Resp = ""
            Meal = vbNo
            GFO = vbNo
            Tbl = ""
            BckMeal = vbNo
            ' go back
            GoTo Coda

            ' if not, quit
            Else
            Exit Sub
        End If

       'Application.EnableEvents = True

End Sub

Hope this sorts things for you. If so, please remember to mark this Answer as Selected.

Discuss

Discussion

Hi John,

Yes it works well. 
One last thing .How can we ask  if the User wants to continue adding Residents  or are they finished in which case exit sub
Garry
Wilsons51 (rep: 4) Oct 31, '23 at 10:53 pm
Garry

You're new here but please note for the future that we not keen on answering a question then the user asking "What about adding more to do..." (If a question is answered fully, it should be selected).

I'll help again this time but do you mean ask the spreadsheet user if they're done or do you want to give an option to insert rows for extra guests (after the Villa's entries or at the bottom) ?
John_Ru (rep: 6232) Nov 1, '23 at 4:12 am
Further to my (unanswered) question above), I've modified my Answer to allow another Villa to book meals/ a tabe. Please review iy and remember to mark it as Selected.
John_Ru (rep: 6232) Nov 2, '23 at 8:10 am
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login