For Each c with Do Loop - Help

bong25

New Member
Joined
Jun 23, 2009
Messages
38
Hi again,

I have this code:

Code:
Dim mc As Control
Dim hasselect As Boolean
hasselect = False
Dim cbT
Dim Z
Z = 0

For Each mc In Me.Controls
If TypeName(mc) = "TextBox" Then
    Do Until Z = 13
        If mc.ControlTipText = "Required" And Not IsEmpty(mc) Then
        Z = Z + 1
    Loop
ElseIf TypeName(mc) = "CheckBox" And mc.Value = True Then
    hasselect = True
    cbT.Value = mc.Caption
Exit Sub
End If
Next mc

If Not Z = 13 Then
MsgBox "Following required fields must be filled in:" & vbCrLf & _
       "1. Year" & vbCrLf & _
       "2. Date" & vbCrLf & _
       "3. Stock Quantity (Tons)" & vbCrLf & _
       "4. Stock Quantity (BDTons)" & vbCrLf & _
       "5. Project Name" & vbCrLf & _
       "6. Project Date" & vbCrLf & _
       "7. Project Quantity" & vbCrLf & _
       "8. Supplier's Name" & vbCrLf & _
       "9. Supplier's Price" & vbCrLf & _
       "10. Supplier's Date" & vbCrLf & _
       "11. Proposed Price"
                    
ElseIf Z = 13 Then
    LRowCll.Offset(1, 0).Value = Application.WorksheetFunction.Max(rng) + 1
    LRowCll.Offset(1, 1).Value = TextBox1.Value
    LRowCll.Offset(1, 2).Value = TextBox2.Value
    LRowCll.Offset(1, 3).Value = cbT.Value
    LRowCll.Offset(1, 4).Value = TextBox3.Value
    LRowCll.Offset(1, 5).Value = TextBox4.Value
    LRowCll.Offset(1, 6).Value = TextBox5.Value
    LRowCll.Offset(1, 7).Value = TextBox6.Value
    LRowCll.Offset(1, 8).Value = TextBox7.Value
    LRowCll.Offset(1, 9).Value = TextBox10.Value
    LRowCll.Offset(1, 10).Value = TextBox11.Value
    LRowCll.Offset(1, 11).Value = TextBox8.Value
    LRowCll.Offset(1, 12).Value = TextBox9.Value
    LRowCll.Offset(1, 13).Value = TextBox12.Value
    LRowCll.Offset(1, 14).Value = TextBox13.Value
    LRowCll.Offset(1, 15).Value = TextBox14.Value
    LRowCll.Offset(1, 16).Value = TextBox15.Value
    LRowCll.Offset(1, 17).Value = TextBox16.Value
    LRowCll.Offset(1, 18).Value = TextBox17.Value
    LRowCll.Offset(1, 19).Value = TextBox18.Value
    LRowCll.Offset(1, 20).Value = TextBox19.Value
    LRowCll.Offset(1, 21).Value = TextBox20.Value
    LRowCll.Offset(1, 22).Value = TextBox21.Value
    LRowCll.Offset(1, 23).Value = TextBox22.Value
    LRowCll.Offset(1, 24).Value = TextBox23.Value
    LRowCll.Offset(1, 25).Value = TextBox24.Value
    LRowCll.Offset(1, 26).Value = TextBox25.Value
    LRowCll.Offset(1, 27).Value = TextBox26.Value
    LRowCll.Offset(1, 28).Value = TextBox27.Value
    LRowCll.Offset(1, 29).Value = TextBox28.Value
    LRowCll.Offset(1, 30).Value = ComboBox1.Value
    
ElseIf hasselect = False Then
    MsgBox "Come on! Please THICK One!"

End If

It show "Compile Error: Loop without Do"

With my little brain, I could not do it properly, I spend already week to try so many approach and can't get things to work.

Please help.
 
I reckon the statement to check if True should be contained within its' own If statement:

Code:
ElseIf TypeName(mc) = "CheckBox" Then
    If mc.Value = True Then
        'Do stuff
    End If
 
Upvote 0

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
I have modified the codes a bit, but this time no error but no result :(.

Code:
Dim mc As Control
Dim mc2 As Control
Dim hasselect As Boolean
hasselect = False
Dim cbT As Boolean
cbT = False

For Each mc In Me.Controls
If TypeName(mc) = "TextBox" Then
  If mc.ControlTipText = "Required" And mc.Text <> "" Then
   cbT = True
   Exit For
   
  End If
Exit Sub
End If
Next mc

For Each mc2 In Me.Controls
If TypeName(mc2) = "CheckBox" Then
        If mc2.Value = True Then
            hasselect = True
            Exit For
        End If
Exit Sub
End If
Next mc2

If cbT = False Then
MsgBox "Following required fields must be filled in:" & vbCrLf & _
       "1. Year" & vbCrLf & _
       "2. Date" & vbCrLf & _
       "3. Stock Quantity (Tons)" & vbCrLf & _
       "4. Stock Quantity (BDTons)" & vbCrLf & _
       "5. Project Name" & vbCrLf & _
       "6. Project Date" & vbCrLf & _
       "7. Project Quantity" & vbCrLf & _
       "8. Supplier's Name" & vbCrLf & _
       "9. Supplier's Price" & vbCrLf & _
       "10. Supplier's Date" & vbCrLf & _
       "11. Proposed Price"
                    
ElseIf hasselect = False Then
    MsgBox "Come on! Please THICK One!"

ElseIf cbT = True And hasselect = True Then
    LRowCll.Offset(1, 0).Value = Application.WorksheetFunction.Max(rng) + 1
    LRowCll.Offset(1, 1).Value = TextBox1.Value
    LRowCll.Offset(1, 2).Value = TextBox2.Value
    LRowCll.Offset(1, 3).Value = mc2.Caption
    LRowCll.Offset(1, 4).Value = TextBox3.Value
    LRowCll.Offset(1, 5).Value = TextBox4.Value
    LRowCll.Offset(1, 6).Value = TextBox5.Value
    LRowCll.Offset(1, 7).Value = TextBox6.Value
    LRowCll.Offset(1, 8).Value = TextBox7.Value
    LRowCll.Offset(1, 9).Value = TextBox10.Value
    LRowCll.Offset(1, 10).Value = TextBox11.Value
    LRowCll.Offset(1, 11).Value = TextBox8.Value
    LRowCll.Offset(1, 12).Value = TextBox9.Value
    LRowCll.Offset(1, 13).Value = TextBox12.Value
    LRowCll.Offset(1, 14).Value = TextBox13.Value
    LRowCll.Offset(1, 15).Value = TextBox14.Value
    LRowCll.Offset(1, 16).Value = TextBox15.Value
    LRowCll.Offset(1, 17).Value = TextBox16.Value
    LRowCll.Offset(1, 18).Value = TextBox17.Value
    LRowCll.Offset(1, 19).Value = TextBox18.Value
    LRowCll.Offset(1, 20).Value = TextBox19.Value
    LRowCll.Offset(1, 21).Value = TextBox20.Value
    LRowCll.Offset(1, 22).Value = TextBox21.Value
    LRowCll.Offset(1, 23).Value = TextBox22.Value
    LRowCll.Offset(1, 24).Value = TextBox23.Value
    LRowCll.Offset(1, 25).Value = TextBox24.Value
    LRowCll.Offset(1, 26).Value = TextBox25.Value
    LRowCll.Offset(1, 27).Value = TextBox26.Value
    LRowCll.Offset(1, 28).Value = TextBox27.Value
    LRowCll.Offset(1, 29).Value = TextBox28.Value
    LRowCll.Offset(1, 30).Value = ComboBox1.Value
    
    End If
    
End Sub
Any Idea?
 
Upvote 0
GOT IT!

Thanks for the help guys.

This is the final code:

Code:
Private Sub OKButton_Click()
Sheets(1).Activate
Dim rng As Range
Dim LRowCll As Range
    Set LRowCll = Cells(Rows.Count, 1).End(xlUp)
    Set rng = Range(Cells(FirstDataRw, 1), LRowCll)
    
Dim mc As Control
Dim mc2 As Control
Dim hasselect As Boolean
hasselect = False
Dim cbT As Boolean
cbT = True

For Each mc In Me.Controls
If TypeName(mc) = "TextBox" Then
  If mc.ControlTipText = "Required" And mc.Text = "" Then
   cbT = False 'rue
   Exit For
  End If

End If
Next mc

For Each mc2 In Me.Controls
If TypeName(mc2) = "CheckBox" Then
        If mc2.Value = True Then
            hasselect = True
            Exit For
        End If

End If
Next mc2

MsgBox "cbT: " & cbT & "  hasselect: " & hasselect

If cbT = False Then
MsgBox "Following required fields must be filled in:" & vbCrLf & _
       "1. Year" & vbCrLf & _
       "2. Date" & vbCrLf & _
       "3. Stock Quantity (Tons)" & vbCrLf & _
       "4. Stock Quantity (BDTons)" & vbCrLf & _
       "5. Project Name" & vbCrLf & _
       "6. Project Date" & vbCrLf & _
       "7. Project Quantity" & vbCrLf & _
       "8. Supplier's Name" & vbCrLf & _
       "9. Supplier's Price" & vbCrLf & _
       "10. Supplier's Date" & vbCrLf & _
       "11. Proposed Price"
                    
ElseIf hasselect = False Then
    MsgBox "Come on! Please THICK One!"

ElseIf cbT = True And hasselect = True Then
    LRowCll.Offset(1, 0).Value = Application.WorksheetFunction.Max(rng) + 1
    LRowCll.Offset(1, 1).Value = TextBox1.Value
    LRowCll.Offset(1, 2).Value = TextBox2.Value
    LRowCll.Offset(1, 3).Value = mc2.Caption
    LRowCll.Offset(1, 4).Value = TextBox3.Value
    LRowCll.Offset(1, 5).Value = TextBox4.Value
    LRowCll.Offset(1, 6).Value = TextBox5.Value
    LRowCll.Offset(1, 7).Value = TextBox6.Value
    LRowCll.Offset(1, 8).Value = TextBox7.Value
    LRowCll.Offset(1, 9).Value = TextBox10.Value
    LRowCll.Offset(1, 10).Value = TextBox11.Value
    LRowCll.Offset(1, 11).Value = TextBox8.Value
    LRowCll.Offset(1, 12).Value = TextBox9.Value
    LRowCll.Offset(1, 13).Value = TextBox12.Value
    LRowCll.Offset(1, 14).Value = TextBox13.Value
    LRowCll.Offset(1, 15).Value = TextBox14.Value
    LRowCll.Offset(1, 16).Value = TextBox15.Value
    LRowCll.Offset(1, 17).Value = TextBox16.Value
    LRowCll.Offset(1, 18).Value = TextBox17.Value
    LRowCll.Offset(1, 19).Value = TextBox18.Value
    LRowCll.Offset(1, 20).Value = TextBox19.Value
    LRowCll.Offset(1, 21).Value = TextBox20.Value
    LRowCll.Offset(1, 22).Value = TextBox21.Value
    LRowCll.Offset(1, 23).Value = TextBox22.Value
    LRowCll.Offset(1, 24).Value = TextBox23.Value
    LRowCll.Offset(1, 25).Value = TextBox24.Value
    LRowCll.Offset(1, 26).Value = TextBox25.Value
    LRowCll.Offset(1, 27).Value = TextBox26.Value
    LRowCll.Offset(1, 28).Value = TextBox27.Value
    LRowCll.Offset(1, 29).Value = TextBox28.Value
    LRowCll.Offset(1, 30).Value = ComboBox1.Value
    
    End If
Call UserForm_Initialize
End Sub
 
Upvote 0

Forum statistics

Threads
1,224,521
Messages
6,179,289
Members
452,902
Latest member
Knuddeluff

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