VBA Simplification Help for Userform

[Ben85]

I am trying to see about simplifying my code. I was thinking if it was possible to do a loop it would be much easier, but I am not sure if it is... Any help would be appreciated.

What I was thinking about if even possible...

Dim I  As Integer
i = 1

Do Until i = 8
      label_ & i = Range("c_form" & i).Text
      tb_f & i .Text = "0.0000"
      i = i +1
Loop

Here is my current actual code. For the Userform activation

Private Sub UserForm_Activate()
    Dim PW As String
    Dim USER As String
    Dim i As Integer
    
    'Labels based off names of forms from table
    label_1 = Range("c_form1").Text
    label_2 = Range("c_form2").Text
    label_3 = Range("c_form3").Text
    label_4 = Range("c_form4").Text
    label_5 = Range("c_form5").Text
    label_6 = Range("c_form6").Text
    label_7 = Range("c_form7").Text
    label_8 = Range("c_form8").Text


    USER = Range("c_user").Text
    PW = Range("c_pass2").Text
    
    'Load Forms "Master" Values from worksheet
    F1m = Range("c_f1m")
    F2m = Range("c_f2m")
    F3m = Range("c_f3m")
    F4m = Range("c_f4m")
    F5m = Range("c_f5m")
    F6m = Range("c_f6m")
    F7m = Range("c_f7m")
    F8m = Range("c_f8m")
    
    'Populate text boxes.
    tb_User = USER
    tb_date = Format(Now, "mm/dd/yy h:mm am/PM")
    tb_f1.Text = "0.0000"
    tb_f2.Text = "0.0000"
    tb_f3.Text = "0.0000"
    tb_f4.Text = "0.0000"
    tb_f5.Text = "0.0000"
    tb_f6.Text = "0.0000"
    tb_f7.Text = "0.0000"
    tb_f8.Text = "0.0000"
    
    tb_f1m = Format(F1m, "0.0000")
    tb_f2m = Format(F2m, "0.0000")
    tb_f3m = Format(F3m, "0.0000")
    tb_f4m = Format(F4m, "0.0000")
    tb_f5m = Format(F5m, "0.0000")
    tb_f6m = Format(F6m, "0.0000")
    tb_f7m = Format(F7m, "0.0000")
    tb_f8m = Format(F8m, "0.0000")
    
    tb_f1.SetFocus
    tb_notes = ""
End Sub

As well as my code for when the Accept button on the UserForm is clicked.

Private Sub btn_accept_Click()
    Dim PW As String
    Dim USER As String
    Dim ConfirmPW As String
    Dim ProtPW As String
    Dim LastRow As Long
    Dim NewRow As Long
    Dim Ref As Range
    
    USER = Range("c_user").Text
    PW = Range("c_pass2").Text
    ProtPW = Range("c_pass").Text


    If tb_f1.Value = 0 And tb_f2.Value = 0 And tb_f3.Value = 0 And tb_f4.Value = 0 And _
        tb_f5.Value = 0 And tb_f6.Value = 0 And tb_f7.Value = 0 And tb_f8.Value = 0 Then
        If MsgBox("No changes made. Continue?", vbOKCancel) = vbCancel Then
            Unload Me
            Exit Sub
        End If
    End If
    
    If tb_f1.Value = "" Or tb_f2.Value = "" Or tb_f3.Value = "" Or tb_f4.Value = "" _
        Or tb_f5.Value = "" Or tb_f6.Value = "" Or tb_f7.Value = "" Or tb_f8.Value = "" Then
        MsgBox ("Cannot leave a entry BLANK. (Zero is acceptable.)")
            Exit Sub
    End If
    
    ConfirmPW = InputBox("Confirm Password for current user (" & USER & ").", "Password")
        If ConfirmPW = PW Then
            'If Password checks good then all entries will be loaded.
            'Determine emptyRow
            'LastRow = DieDim.Range("A3").End(xlDown).Offset(1, 0).Select
            NewRow = Application.WorksheetFunction.CountA(Range("A:A")) + 2
            LastRow = Application.WorksheetFunction.CountA(Range("A:A")) + 1
            
            'Unprotect Worksheet.
            If Range("c_admin") = False Then
                DieDim.Unprotect ProtPW
            End If


            'Transfer information
            'Increment# entry
            If Cells(LastRow, 1).Value = "MASTER" Then
                Cells(NewRow, 1) = 1
            Else
                Cells(NewRow, 1) = Cells(LastRow, 1).Value + 1
            End If
            
            'Add Date to row
            Cells(NewRow, 2) = Format(Now, "mm/dd/yy h:mm am/PM")
            'Add Employee# to row
            Cells(NewRow, 3) = tb_User.Text
            'Tranfer Form1
            Set Ref = Cells(NewRow, 4)
                If tb_f1.Value = 0 Or tb_f1m.Value Then
                    Ref.Value = Cells(LastRow, 4).Value
                Else
                    Ref.Value = tb_f1.Value
                    Ref.Interior.ColorIndex = 19 'Colors: 19=LightYellow, 20=LightBlue, 35=LightGreen
                End If
            'Tranfer Form2
            Set Ref = Cells(NewRow, 5)
                If tb_f2.Value = 0 Or tb_f2m.Value Then
                    Ref.Value = Cells(LastRow, 5).Value
                Else
                    Ref.Value = tb_f2.Value
                    Ref.Interior.ColorIndex = 19 'Yellow Fill
                End If
            'Tranfer Form3
            Set Ref = Cells(NewRow, 6)
                If tb_f3.Value = 0 Or tb_f3m.Value Then
                    Ref.Value = Cells(LastRow, 6).Value
                Else
                    Ref.Value = tb_f3.Value
                    Ref.Interior.ColorIndex = 19 'Yellow Fill
                End If
            'Tranfer Form4
            Set Ref = Cells(NewRow, 7)
                If tb_f4.Value = 0 Or tb_f4m.Value Then
                    Ref.Value = Cells(LastRow, 7).Value
                Else
                    Ref.Value = tb_f4.Value
                    Ref.Interior.ColorIndex = 19 'Yellow Fill
                End If
            'Tranfer Form5
            Set Ref = Cells(NewRow, 8)
                If tb_f5.Value = 0 Or tb_f5m.Value Then
                    Ref.Value = Cells(LastRow, 8).Value
                Else
                    Ref.Value = tb_f5.Value
                    Ref.Interior.ColorIndex = 19 'Yellow Fill
                End If
            'Tranfer Form6
            Set Ref = Cells(NewRow, 9)
                If tb_f6.Value = 0 Or tb_f6m.Value Then
                    Ref.Value = Cells(LastRow, 9).Value
                Else
                    Ref.Value = tb_f6.Value
                    Ref.Interior.ColorIndex = 19 'Yellow Fill
                End If
            'Tranfer Form7
            Set Ref = Cells(NewRow, 10)
                If tb_f7.Value = 0 Or tb_f7m.Value Then
                    Ref.Value = Cells(LastRow, 10).Value
                Else
                    Ref.Value = tb_f7.Value
                    Ref.Interior.ColorIndex = 19 'Yellow Fill
                End If
            'Tranfer Form8
            Set Ref = Cells(NewRow, 11)
                If tb_f8.Value = 0 Or tb_f8m.Value Then
                    Ref.Value = Cells(LastRow, 11).Value
                Else
                    Ref.Value = tb_f8.Value
                    Ref.Interior.ColorIndex = 19 'Yellow Fill
                End If
            'Transfer NOTES
            Cells(NewRow, 12) = tb_notes.Text
            Unload Me


            'Protect Worksheet if not admin.
            If Range("c_admin") = False Then
                DieDim.Protect ProtPW
            End If
            ActiveWorkbook.Save
            Unload Me
        Else
            'Bad password entry. Cancels Data Entry.
            MsgBox ("Password incorrect. Data Entry Rejected.")
            Unload Me
        End If
End Sub

I am sure my code will get laughed at, but I would love some help cleaning it up and simplifying it a bit!

 

[Norie]

You can use the Controls collection of the userform.

For I = 1 To 8
    Me.Controls("label_" & I) = Range("c_form" & i).Text
    Me.Controls("tb_f" & I).Text = "0.0000"      
Next I

 

[Ben85]

You can use the Controls collection of the userform.

For I = 1 To 8
    Me.Controls("label_" & I) = Range("c_form" & i).Text
    Me.Controls("tb_f" & I).Text = "0.0000"      
Next I

Thank you Norie! That did help me clean up my code quite a bit, and I made some changes to hopefully simplify when I need to make additions in the future.

Here is my new code.

Option Explicit
Public NumberOfForms As Byte
Public i As Byte

Private Sub UserForm_Activate()    Dim PW As String
    Dim USER As String


    NumberOfForms = 8
    
    For i = 1 To NumberOfForms
    'Pull labels based off form names.
        Me.Controls("label_" & i) = Range("c_form" & i).Text
    'Pulls MASTER dimensions for forms.
        Me.Controls("tb_fm" & i) = Format(Range("c_fm" & i), "0.0000")
    Next i


    USER = Range("c_user").Text
    PW = Range("c_pass2").Text
    
    'Populate text boxes.
    tb_User = USER
    tb_date = Format(Now, "mm/dd/yy h:mm am/PM")
    
    tb_f1.SetFocus
    tb_notes = ""
End Sub

Private Sub btn_accept_Click()    Dim PW As String
    Dim USER As String
    Dim ConfirmPW As String
    Dim ProtPW As String
    Dim LastRow As Long
    Dim NewRow As Long
    Dim Ref As Range
    Dim RefLast As Range
    Dim cnt As Byte
    Dim UserFormEntry
    
    USER = Range("c_user").Text
    PW = Range("c_pass2").Text
    ProtPW = Range("c_pass").Text


    cnt = 1
    For i = 1 To NumberOfForms
        Me.Controls("tb_f" & i) = Format(Me.Controls("tb_f" & i), "0.0000")
        
        If Me.Controls("tb_f" & i).Value = 0 Then
            cnt = cnt + 1
        End If
        
        If Me.Controls("tb_f" & i).Value = "" Then
            MsgBox ("Cannot Leave an entry BLANK. (Zero is acceptable.)")
            Exit Sub
        End If
    Next i
    
    If cnt = i Then
        If MsgBox("No changes made. Continue?", vbOKCancel) = vbCancel Then
            Unload Me
            Exit Sub
        End If
    End If
    
    ConfirmPW = InputBox("Confirm Password for current user (" & USER & ").", "Password")
        If ConfirmPW = PW Then
            'If Password checks good then all entries will be loaded.
            NewRow = Application.WorksheetFunction.CountA(Range("A:A")) + 2
            LastRow = Application.WorksheetFunction.CountA(Range("A:A")) + 1
            
            'Unprotect Worksheet.
            If Range("c_admin") = False Then
                DieDim.Unprotect ProtPW
            End If


            'Transfer information
            'Increment# entry
            If Cells(LastRow, 1).Value = "MASTER" Then
                Cells(NewRow, 1) = 1
                Else
                    Cells(NewRow, 1) = Cells(LastRow, 1).Value + 1
            End If
            
            'Add Date to row
            Cells(NewRow, 2) = Format(Now, "mm/dd/yy h:mm am/PM")
            
            'Add Employee# to row
            Cells(NewRow, 3) = tb_User.Text
            
            'Transfer Userform dim entries.
            For i = 1 To NumberOfForms
                Set Ref = Cells(NewRow, i + 3)
                Set RefLast = Cells(LastRow, i + 3)
                RefLast = Format(RefLast, "0.0000")
                    If Me.Controls("tb_f" & i).Value = 0 Or Me.Controls("tb_f" & i) = RefLast Then
                        Ref.Value = Cells(LastRow, i + 3).Value
                        Else
                        Ref.Value = Me.Controls("tb_f" & i).Value
                        Ref.Interior.ColorIndex = 19 '(Yellow Fill) 'Colors: 19=LightYellow, 20=LightBlue, 35=LightGreen
                    End If
            Next i
            
            'Transfer NOTES
            Cells(NewRow, NumberOfForms + 4) = tb_notes.Text
            Unload Me


            'Protect Worksheet if not admin.
            If Range("c_admin") = False Then
                DieDim.Protect ProtPW
            End If
            ActiveWorkbook.Save
            Unload Me
            Else
            'Bad password entry. Cancels Data Entry.
            MsgBox ("Password incorrect. Data Entry Rejected.")
            Unload Me
        End If
End Sub